diff --git a/.github/coverage/exclude_files.txt b/.github/coverage/exclude_files.txt index 7af042100a..010c469ff8 100644 --- a/.github/coverage/exclude_files.txt +++ b/.github/coverage/exclude_files.txt @@ -128,7 +128,7 @@ src/ssls/sslst.F90 src/ssls/sslsti.F90 src/smt/smtt.F90 src/sort/sortt.F90 -src/ssids/ssidst.F90 +src/slblt/slbltt.F90 src/svt/svtt.F90 src/trb/trbt.F90 src/trb/trbti.F90 @@ -429,33 +429,3 @@ src/nodend/metis52/include/rename_52s.h src/nodend/metis52/include/stdheaders_52.h src/nodend/metis52/include/struct_52.h src/nodend/metis52/include/test_proto_52.h -include/spral_compat.hxx -include/spral_guess_topology.hxx -include/spral_hwloc_wrapper.hxx -include/spral_omp.hxx -include/ssids_cpu_AppendAlloc.hxx -include/ssids_cpu_BlockPool.hxx -include/ssids_cpu_BuddyAllocator.hxx -include/ssids_cpu_NumericNode.hxx -include/ssids_cpu_NumericSubtree.hxx -include/ssids_cpu_SmallLeafNumericSubtree.hxx -include/ssids_cpu_SmallLeafSymbolicSubtree.hxx -include/ssids_cpu_SymbolicNode.hxx -include/ssids_cpu_SymbolicSubtree.hxx -include/ssids_cpu_ThreadStats.hxx -include/ssids_cpu_Workspace.hxx -include/ssids_cpu_cpu_iface.hxx -include/ssids_cpu_factor.hxx -include/ssids_cpu_kernels_SimdVec.hxx -include/ssids_cpu_kernels_assemble.hxx -include/ssids_cpu_kernels_block_ldlt.hxx -include/ssids_cpu_kernels_calc_ld.hxx -include/ssids_cpu_kernels_cholesky.hxx -include/ssids_cpu_kernels_common.hxx -include/ssids_cpu_kernels_ldlt_app.hxx -include/ssids_cpu_kernels_ldlt_nopiv.hxx -include/ssids_cpu_kernels_ldlt_tpp.hxx -include/ssids_cpu_kernels_verify.hxx -include/ssids_cpu_kernels_wrappers.hxx -include/ssids_profile.hxx -include/ssids_rip.hxx diff --git a/.github/julia/build_tarballs_int32.jl b/.github/julia/build_tarballs_int32.jl index 763938b6c5..043e802c96 100644 --- a/.github/julia/build_tarballs_int32.jl +++ b/.github/julia/build_tarballs_int32.jl @@ -10,9 +10,9 @@ version = VersionNumber(ENV["GALAHAD_RELEASE"]) # Collection of sources required to complete build sources = [ GitSource(ENV["GALAHAD_URL"], ENV["GALAHAD_COMMIT"]), - # MUMPS v5.9.0 - ArchiveSource("https://mumps-solver.org/MUMPS_5.9.0.tar.gz", - "02c6efdb91749ec0f82351d40f3f860547272a1eb1d899126a4265b4d6bcc4ca"), + # MUMPS v5.9.1 + ArchiveSource("https://mumps-solver.org/MUMPS_5.9.1.tar.gz", + "659c9b57646b5a003ac618baa1faf9dd2044e46c732b3daaccbc7158003e1b46"), ] # Bash recipe for building across all platforms @@ -88,12 +88,6 @@ cp lib/*.${dlext} ${libdir} # Compile GALAHAD cd ${WORKSPACE}/srcdir/GALAHAD -if [[ "${target}" == *mingw* ]]; then - HWLOC="hwloc-15" -else - HWLOC="hwloc" -fi - QUADRUPLE="true" if [[ "${target}" == *arm* ]] || [[ "${target}" == *aarch64-linux* ]] || [[ "${target}" == *aarch64-unknown-freebsd* ]] || [[ "${target}" == *powerpc64le-linux-gnu* ]] || [[ "${target}" == *riscv64* ]]; then QUADRUPLE="false" @@ -101,7 +95,6 @@ fi meson setup builddir_int32 --cross-file=${MESON_TARGET_TOOLCHAIN%.*}_gcc.meson \ --prefix=$prefix \ - -Dlibhwloc=$HWLOC \ -Dlibblas=openblas \ -Dliblapack=openblas \ -Dsingle=true \ @@ -139,7 +132,6 @@ dependencies = [ Dependency(PackageSpec(name="CompilerSupportLibraries_jll", uuid="e66e0078-7015-5450-92f7-15fbd957f2ae")), Dependency(PackageSpec(name="METIS_jll", uuid="d00139f3-1899-568f-a2f0-47f597d42d70")), Dependency(PackageSpec(name="OpenBLAS32_jll", uuid="656ef2d0-ae68-5445-9ca0-591084a874a2")), - Dependency(PackageSpec(name="Hwloc_jll", uuid="e33a78d0-f292-5ffc-b300-72abe9b543c8")), Dependency(PackageSpec(name="HSL_jll", uuid="017b0a0e-03f4-516a-9b91-836bbd1904dd"), compat="4.0.5"), Dependency(PackageSpec(name="CUTEst_jll", uuid="bb5f6f25-f23d-57fd-8f90-3ef7bad1d825"), compat="2.7.0"), ] diff --git a/.github/julia/build_tarballs_int64.jl b/.github/julia/build_tarballs_int64.jl index 38c891862f..d511df8255 100644 --- a/.github/julia/build_tarballs_int64.jl +++ b/.github/julia/build_tarballs_int64.jl @@ -38,12 +38,6 @@ cp ${host_prefix}/bin/ninja /usr/bin/ninja # Compile GALAHAD cd ${WORKSPACE}/srcdir/GALAHAD -if [[ "${target}" == *mingw* ]]; then - HWLOC="hwloc-15" -else - HWLOC="hwloc" -fi - QUADRUPLE="true" if [[ "${target}" == *arm* ]] || [[ "${target}" == *aarch64-linux* ]] || [[ "${target}" == *aarch64-unknown-freebsd* ]] || [[ "${target}" == *powerpc64le-linux-gnu* ]] || [[ "${target}" == *riscv64* ]]; then QUADRUPLE="false" @@ -51,7 +45,6 @@ fi meson setup builddir_int64 --cross-file=${MESON_TARGET_TOOLCHAIN%.*}_gcc.meson \ --prefix=$prefix \ - -Dlibhwloc=$HWLOC \ -Dlibblas=openblas64_ \ -Dliblapack=openblas64_ \ -Dlibsmumps= \ @@ -91,7 +84,6 @@ dependencies = [ HostBuildDependency(PackageSpec(name="Ninja_jll", uuid="76642167-d241-5cee-8c94-7a494e8cb7b7")), Dependency(PackageSpec(name="CompilerSupportLibraries_jll", uuid="e66e0078-7015-5450-92f7-15fbd957f2ae")), Dependency(PackageSpec(name="OpenBLAS_jll", uuid="4536629a-c528-5b80-bd46-f80d51c5b363")), - Dependency(PackageSpec(name="Hwloc_jll", uuid="e33a78d0-f292-5ffc-b300-72abe9b543c8")), Dependency(PackageSpec(name="HSL_jll", uuid="017b0a0e-03f4-516a-9b91-836bbd1904dd"), compat="4.0.5"), ] diff --git a/.github/julia/check_copies.jl b/.github/julia/check_copies.jl index 4ade23e8d3..d1f4ee36ac 100644 --- a/.github/julia/check_copies.jl +++ b/.github/julia/check_copies.jl @@ -14,8 +14,8 @@ excluded_fortran_fields = Dict( "presolve_control_type" => ["get_q", "get_f", "get_g", "get_H", "get_A", "get_x", "get_x_bounds", "get_z", "get_z_bounds", "get_c", "get_c_bounds", "get_y", "get_y_bounds"], "wcp_inform_type" => ["x_status", "c_status"], "sbls_inform_type" => ["sils_analyse_status", "sils_factorize_status", "sils_solve_status", "sls_analyse_status", "sls_factorize_status", "sls_solve_status", "uls_analyse_status", "uls_factorize_status", "uls_solve_status"], - "ssids_control_type" => ["auction", "rb_dump"], - "ssids_inform_type" => ["auction"], + "slblt_control_type" => ["auction", "rb_dump"], + "slblt_inform_type" => ["auction"], ) function extract_type_fields(text, typename) diff --git a/.github/julia/check_files.jl b/.github/julia/check_files.jl index 36842c677c..aad8b231c9 100644 --- a/.github/julia/check_files.jl +++ b/.github/julia/check_files.jl @@ -20,7 +20,6 @@ function meson_check_headers() startswith(file, "galahad_sls_") && continue startswith(file, "cutest_routines_") && continue startswith(file, "hsl_subset_") && continue - startswith(file, "ssids_") && continue (file in excluded_headers) && continue if !occursin(file, content) @@ -86,7 +85,7 @@ function meson_check_files() "trs_paper.F90", "trs_paper_large.F90", "rqs_paper_large.F90", # I should check the following files with Nick! "cdqp_ciface.F90", "check.f90.ver1", "dummy.f", "dummy_hsl.F90", - "dummy_hsl_c.F90", "dummy_spral.F90", "empty", "umfpack.F90", + "dummy_hsl_c.F90", "empty", "umfpack.F90", "filter_orig.F90", "filtrane_ciface.F90", "glrt.f90.1", "glrtti.F90", "glssbig.F90", "glssbig1.F90", "glssbig2.F90", "runl1qp_qplib.F90", "lancelot.pointers.F90", "details", "details2", "runlsrb", "lsqr.F90", diff --git a/.github/julia/check_headers.jl b/.github/julia/check_headers.jl index 3431cecc87..a5f7fbef21 100644 --- a/.github/julia/check_headers.jl +++ b/.github/julia/check_headers.jl @@ -19,7 +19,6 @@ for file in readdir(folder_headers) startswith(file, "galahad_sls_") && continue startswith(file, "cutest_routines_") && continue startswith(file, "hsl_") && continue - startswith(file, "ssids_") && continue (file in excluded_headers) && continue if !occursin(file, content) diff --git a/.github/julia/check_macros.jl b/.github/julia/check_macros.jl index 33f09397a3..eef3bef175 100644 --- a/.github/julia/check_macros.jl +++ b/.github/julia/check_macros.jl @@ -40,7 +40,6 @@ append_macros!(macros, joinpath(@__DIR__, "..", "..", "include", "hsl_subset_cif append_macros!(macros, joinpath(@__DIR__, "..", "..", "include", "hsl_subset_ciface_quadruple.h")) append_macros!(macros, joinpath(@__DIR__, "..", "..", "include", "galahad_cfunctions.h")) append_macros!(macros, joinpath(@__DIR__, "..", "..", "include", "galahad_kinds.h")) -append_macros!(macros, joinpath(@__DIR__, "..", "..", "include", "ssids_routines.h")) # Check the number of characters for (root, dirs, files) in walkdir(joinpath(@__DIR__, "..", "..", "src")) diff --git a/.github/julia/check_modules.jl b/.github/julia/check_modules.jl index 8e796e7912..3da8902b34 100644 --- a/.github/julia/check_modules.jl +++ b/.github/julia/check_modules.jl @@ -68,8 +68,8 @@ single_double_quadruple_modules = ["galahad_blas_interface", "galahad_pastixf_enums", "galahad_pastixf_interfaces", "galahad_spmf_interfaces", - "galahad_hw", - "galahad_hw_64", + "galahad_topology", + "galahad_topology_64", ] for (modules1, modules2, int1, int2, name) in modules_combinations diff --git a/.github/julia/check_structures.jl b/.github/julia/check_structures.jl index 3ab3906403..0bc4b9a662 100644 --- a/.github/julia/check_structures.jl +++ b/.github/julia/check_structures.jl @@ -59,8 +59,8 @@ excluded_fortran_fields = Dict( "presolve_control_type" => ["get_q", "get_f", "get_g", "get_h", "get_a", "get_x", "get_x_bounds", "get_z", "get_z_bounds", "get_c", "get_c_bounds", "get_y", "get_y_bounds"], "wcp_inform_type" => ["x_status", "c_status"], "sbls_inform_type" => ["sils_analyse_status", "sils_factorize_status", "sils_solve_status", "sls_analyse_status", "sls_factorize_status", "sls_solve_status", "uls_analyse_status", "uls_factorize_status", "uls_solve_status"], - "ssids_control_type" => ["auction", "rb_dump"], - "ssids_inform_type" => ["auction"], + "slblt_control_type" => ["auction", "rb_dump"], + "slblt_inform_type" => ["auction"], "ugo_inform_type" => ["dx_best"], ) @@ -78,7 +78,7 @@ function F_structures() (folders[end-1] != "forthcoming") && (folders[end-1] != "src") && continue package = folders[end] if file == "$package.F90" - if package == "ssids" + if package == "slblt" path = joinpath(root, "types.F90") |> normpath end code = read(path, String) @@ -104,7 +104,7 @@ function F_structures() f_extend[f_struct] = lowercase(extension) |> strip end end - if contains(line |> uppercase, "TYPE SSIDS_INFORM") || contains(line |> uppercase, "TYPE SSIDS_OPTIONS") + if contains(line |> uppercase, "TYPE SLBLT_INFORM") || contains(line |> uppercase, "TYPE SLBLT_OPTIONS") f_struct = split(line, "type")[2] |> strip f_types[f_struct] = String[] f_structures[f_struct] = String[] diff --git a/.github/julia/check_symbols.jl b/.github/julia/check_symbols.jl index 8d2b48e437..f270047eb5 100644 --- a/.github/julia/check_symbols.jl +++ b/.github/julia/check_symbols.jl @@ -9,7 +9,6 @@ function exported_symbols(path::String) for line in lines tab = split(line, " ", keepempty=false) symbol = tab[1] - symbol = readchomp(`c++filt -t $symbol`) push!(symbols, symbol) end return symbols @@ -42,11 +41,11 @@ single_double_quadruple_modules = ["hash_MOD", "string_MOD", "string_64_MOD", "c "common_ciface_MOD", "hash_ciface_MOD", "hash_64_MOD", "hash_ciface_64_MOD", "hsl_kb22_long_integer_MOD", "hsl_mc68_integer_ciface_MOD", "hsl_mc68_integer_MOD", "hsl_mc78_integer_MOD", "hsl_mc78_integer_64_MOD", "hsl_zb01_integer_MOD", "hsl_of01_integer_MOD", "hsl_of01_integer_64_MOD", "mkl_pardiso_private_MOD", "pastixf_enums_MOD", "pastixf_interfaces_MOD", "spmf_enums_MOD", - "spral_pgm_64_MOD", "pastixf_enums_64_MOD", "mkl_pardiso_private_64_MOD", "spmf_enums_64_MOD", "spral_hw_topology_64_MOD", - "spral_metis_wrapper_64_MOD", "tools_64_MOD", "galahad_symbols_64_MOD", "hsl_mc68_integer_64_ciface_MOD", "hsl_kb22_long_integer_64_MOD", + "pastixf_enums_64_MOD", "mkl_pardiso_private_64_MOD", "spmf_enums_64_MOD", + "tools_64_MOD", "galahad_symbols_64_MOD", "hsl_mc68_integer_64_ciface_MOD", "hsl_kb22_long_integer_64_MOD", "common_ciface_64_MOD", "clock_64_MOD", "hsl_mc68_integer_64_MOD", "hsl_zb01_integer_64_MOD", "copyright_64_MOD", - "version_64_MOD", "galahad_hw_MOD", "galahad_hw_64_MOD", "spral_metis_wrapper_MOD", "spral_core_analyse_64_MOD", - "galahad_version_MOD", "galahad_ssids_profile_MOD", "galahad_ssids_profile_64_MOD", "galahad_spmf_interfaces_MOD", + "version_64_MOD", "galahad_topology_MOD", "galahad_topology_64_MOD", + "galahad_version_MOD", "galahad_spmf_interfaces_MOD", "galahad_spmf_interfaces_64_MOD", "galahad_pastixf_interfaces_MOD", "galahad_pastixf_interfaces_64_MOD"] metis_adapters = ["galahad_nodend4_adapter", "galahad_nodend51_adapter", "galahad_nodend52_adapter"] @@ -63,7 +62,7 @@ metis_symbols = ["PrintBackTrace", "errexit", "getpathname", "iAllocMatrix", "iF "rpqFree", "rpqGetTop", "rpqInit", "rpqInsert", "rpqLength", "rpqReset", "rpqSeeKey", "rpqSeeTopKey", "rpqSeeTopVal", "rpqUpdate", "rrealloc", "rscale", "rset", "rsmalloc", "rsortd", "rsorti", "rsum", "uvwsorti"] -unknown_symbols = ["errexit", "getpathname", "gkfooo", "main", "PrintBackTrace", "spral_hw_topology_free", "spral_hw_topology_guess", +unknown_symbols = ["errexit", "getpathname", "gkfooo", "main", "PrintBackTrace", "Test_ND", "VerifyND", "xerbla2_"] for (symbols1, symbols2, int1, int2, name) in symbols_combinations @@ -84,13 +83,8 @@ for (symbols1, symbols2, int1, int2, name) in symbols_combinations flag11 = mapreduce(x -> symbol == x, |, unknown_symbols) flag12 = mapreduce(x -> symbol == x || symbol == x * "_64", |, metis_adapters) flag13 = mapreduce(x -> symbol == x * "_51" || symbol == x * "_51_64" || symbol == x * "_52" || symbol == x * "_52_64", |, metis_symbols) - flag14 = mapreduce(x -> contains(symbol, x), |, ["::", "<", ">"]) && (int1 == int2) - flag15 = contains(symbol, "std::") || contains(symbol, "__gnu_cxx::") - flag16 = contains(symbol, "operator delete") || contains(symbol, "operator new") - flag17 = contains(symbol, "galahad_ssids_cpu_create_symbolic_subtree") || contains(symbol, "galahad_ssids_cpu_destroy_symbolic_subtree") - flag18 = contains(symbol, "galahad_hw_topology_guess") || contains(symbol, "galahad_hw_topology_free") if !flag1 && !flag2 && !flag3 && !flag4 && !flag5 && !flag6 && !flag7 && !flag8 && !flag9 && !flag10 - if !flag11 && !flag12 && !flag13 && !flag14 && !flag15 && !flag16 && !flag17 && !flag18 + if !flag11 && !flag12 && !flag13 println(symbol) global n = n+1 end diff --git a/.github/workflows/dummy_ssids.yml b/.github/workflows/dummy_ssids.yml deleted file mode 100644 index 8894eacbe0..0000000000 --- a/.github/workflows/dummy_ssids.yml +++ /dev/null @@ -1,40 +0,0 @@ -name: Meson -on: - push: - branches: - - master - pull_request: - types: [opened, synchronize, reopened] -jobs: - build: - name: Compilation with the dummy SSIDS - runs-on: ubuntu-latest - steps: - - name: Checkout GALAHAD - uses: actions/checkout@v4 - - - name: Setup Python - uses: actions/setup-python@v5 - with: - python-version: '3.13' - - - name: Install Meson and Ninja - run: pip install meson ninja - - - name: Install compilers - uses: fortran-lang/setup-fortran@main - with: - compiler: "gcc" - version: "11" - - - name: Setup GALAHAD - shell: bash - run: | - meson setup builddir_int32 --buildtype=debug -Dquadruple=true -Dint64=false -Dssids=false -Dlibblas= -Dliblapack= - meson setup builddir_int64 --buildtype=debug -Dquadruple=true -Dint64=true -Dssids=false -Dlibblas= -Dliblapack= - - - name: Build GALAHAD - shell: bash - run: | - meson compile -C builddir_int32 - meson compile -C builddir_int64 diff --git a/.github/workflows/meson_build.yml b/.github/workflows/meson_build.yml index 4542698d21..5097ee3166 100644 --- a/.github/workflows/meson_build.yml +++ b/.github/workflows/meson_build.yml @@ -127,7 +127,7 @@ jobs: run: | echo "LSAN_OPTIONS=suppressions=$GITHUB_WORKSPACE/.github/lsan_suppressions.txt" >> $GITHUB_ENV - # Exercise SSIDS (GALAHAD's own embedded sparse solver) as both the + # Exercise SLBLT (GALAHAD's own embedded sparse solver) as both the # symmetric and definite linear solver under the sanitizers. The test # drivers read these at run time (see include/galahad_sls_defaults_ls.h), # so no rebuild is needed; unset, they would fall back to sytr / potr. @@ -135,8 +135,8 @@ jobs: if: inputs.sanitizers == 'true' shell: bash run: | - echo "GALAHAD_SYMMETRIC_LINEAR_SOLVER=ssids" >> $GITHUB_ENV - echo "GALAHAD_DEFINITE_LINEAR_SOLVER=ssids" >> $GITHUB_ENV + echo "GALAHAD_SYMMETRIC_LINEAR_SOLVER=slblt" >> $GITHUB_ENV + echo "GALAHAD_DEFINITE_LINEAR_SOLVER=slblt" >> $GITHUB_ENV - name: Set environment variables for self-hosted runner if: inputs.os == 'self-hosted' @@ -157,7 +157,7 @@ jobs: if: inputs.os != 'windows-latest' && inputs.compiler != 'nvidia-hpc' shell: bash run: | - VERSION_CUTEST="2.6.0" + VERSION_CUTEST="2.7.1" INT64="false" if [[ "${{ inputs.int }}" == "64" ]]; then INT64="true" @@ -226,7 +226,7 @@ jobs: meson compile -C builddir meson install -C builddir else - VERSION_LIBHSL="4.0.6" + VERSION_LIBHSL="4.0.7" cd .. if [[ "${{ inputs.os }}" == "windows-latest" ]]; then wget https://github.com/ralna/libHSL/archive/refs/tags/v${VERSION_LIBHSL}.zip @@ -261,11 +261,14 @@ jobs: echo "PASTIX_INT64=OFF" >> $GITHUB_ENV fi if [[ "${{ inputs.os }}" == "ubuntu-latest" || "${{ inputs.os }}" == "ubuntu-24.04-arm" ]]; then - sudo apt-get -y install libhwloc-dev libopenblas-dev liblapacke-dev bison flex + sudo apt-get -y install libopenblas-dev liblapacke-dev libhwloc-dev bison flex elif [[ "${{ inputs.os }}" == "macos-15-intel" || "${{ inputs.os }}" == "macos-latest" ]]; then brew install hwloc openblas bison flex # brew's bison/flex are keg-only (SCOTCH needs a recent bison/flex) and - # OpenBLAS/hwloc are keg-only too; expose them to the later build steps + # OpenBLAS/hwloc are keg-only too; expose them to the later build steps. + # hwloc is a dependency of PaStiX/SCOTCH (GALAHAD itself no longer uses + # it): without it PaStiX falls back to isched_nohwloc.c, which fails to + # compile on macOS (CTL_HW / HW_NCPU undeclared). echo "$(brew --prefix bison)/bin" >> $GITHUB_PATH echo "$(brew --prefix flex)/bin" >> $GITHUB_PATH echo "CMAKE_PREFIX_PATH=$(brew --prefix openblas):$(brew --prefix hwloc):${CMAKE_PREFIX_PATH}" >> $GITHUB_ENV @@ -296,7 +299,7 @@ jobs: if: inputs.compiler == 'gcc' && inputs.os != 'windows-latest' shell: bash run: | - VERSION_SCOTCH="7.0.12" + VERSION_SCOTCH="7.0.13" cd "$DEPS" git clone --depth 1 --branch v${VERSION_SCOTCH} https://gitlab.inria.fr/scotch/scotch.git scotch cd scotch @@ -346,7 +349,7 @@ jobs: if: inputs.compiler == 'gcc' && inputs.os != 'windows-latest' && inputs.int == '32' shell: bash run: | - VERSION_MUMPS="5.9.0" + VERSION_MUMPS="5.9.1" cd "$DEPS" wget -q https://mumps-solver.org/MUMPS_${VERSION_MUMPS}.tar.gz tar -xzf MUMPS_${VERSION_MUMPS}.tar.gz @@ -432,7 +435,6 @@ jobs: CPPSTD="c++11" INT64="false" QUADRUPLE="true" - SSIDS="true" BLAS="" LAPACK="" BLAS_PATH="$DEPS/deps/$LIBDIR" @@ -487,9 +489,6 @@ jobs: if [[ "${{inputs.sanitizers}}" == "true" || ( "${{ inputs.compiler }}" == "intel" && "${{ inputs.os }}" == "windows-latest" ) ]]; then PYTHON_INTERFACE="false" fi - if [[ "${{ inputs.compiler }}" == "nvidia-hpc" || ( "${{ inputs.compiler }}" == "intel" && "${{ inputs.os }}" == "windows-latest" ) ]]; then - SSIDS="false" - fi if [[ "${{ inputs.os }}" == "ubuntu-24.04-arm" || "${{ inputs.compiler }}" == "nvidia-hpc" || "${{ inputs.compiler }}" == "intel" ]]; then QUADRUPLE="false" fi @@ -510,7 +509,6 @@ jobs: -Dexamples=true \ -Dtests=true \ -Dbinaries=true \ - -Dssids=${SSIDS} \ -Dciface=${C_INTERFACE} \ -Dpythoniface=${PYTHON_INTERFACE} \ -Dint64=${INT64} \ diff --git a/.github/workflows/modules.yml b/.github/workflows/modules.yml index 4e411e7d03..afd6a499a2 100644 --- a/.github/workflows/modules.yml +++ b/.github/workflows/modules.yml @@ -30,8 +30,8 @@ jobs: - name: Setup GALAHAD shell: bash run: | - meson setup builddir_int32 --buildtype=debug -Dquadruple=true -Dint64=false -Dssids=true -Dexamples=false -Dtests=false -Dlibblas= -Dliblapack= - meson setup builddir_int64 --buildtype=debug -Dquadruple=true -Dint64=true -Dssids=true -Dexamples=false -Dtests=false -Dlibblas= -Dliblapack= + meson setup builddir_int32 --buildtype=debug -Dquadruple=true -Dint64=false -Dexamples=false -Dtests=false -Dlibblas= -Dliblapack= + meson setup builddir_int64 --buildtype=debug -Dquadruple=true -Dint64=true -Dexamples=false -Dtests=false -Dlibblas= -Dliblapack= - name: Build GALAHAD shell: bash diff --git a/.github/workflows/poison.yml b/.github/workflows/poison.yml index b91d620193..313d9e2c3a 100644 --- a/.github/workflows/poison.yml +++ b/.github/workflows/poison.yml @@ -12,8 +12,7 @@ on: # variables are filled with a non-zero pattern via -ftrivial-auto-var-init, and # Fortran automatics via -finit-*. Combined with AddressSanitizer so that a # poisoned index/pointer that walks off an array is reported cleanly rather than -# as a raw SIGSEGV. This is the build that would have caught the ssids -# find_maxloc int64+single index corruption up front. +# as a raw SIGSEGV. jobs: poison: @@ -57,10 +56,11 @@ jobs: - name: Setup run: | INT64=false - if [[ "${{ matrix.int }}" == "64" ]]; then INT64=true; fi + if [[ "${{ matrix.int }}" == "64" ]]; then + INT64=true; + fi meson setup builddir --buildtype=debug \ -Dint64=$INT64 \ - -Dssids=true \ -Dquadruple=true \ -Dtests=true \ -Dciface=false \ @@ -68,7 +68,6 @@ jobs: -Dliblapack= \ -Db_sanitize=address \ -Dc_args="-ftrivial-auto-var-init=pattern" \ - -Dcpp_args="-ftrivial-auto-var-init=pattern" \ -Dfortran_args="-finit-integer=-99999999 -finit-logical=true -finit-character=35 -finit-derived" - name: Compilation diff --git a/.github/workflows/symbols.yml b/.github/workflows/symbols.yml index e28a70b4c6..dc5f1feaf3 100644 --- a/.github/workflows/symbols.yml +++ b/.github/workflows/symbols.yml @@ -30,8 +30,8 @@ jobs: - name: Setup GALAHAD shell: bash run: | - meson setup builddir_int32 --buildtype=debug -Dquadruple=true -Dint64=false -Dssids=true -Dexamples=false -Dtests=false -Dbinaries=true -Dlibblas= -Dliblapack= - meson setup builddir_int64 --buildtype=debug -Dquadruple=true -Dint64=true -Dssids=true -Dexamples=false -Dtests=false -Dbinaries=true -Dlibblas= -Dliblapack= + meson setup builddir_int32 --buildtype=debug -Dquadruple=true -Dint64=false -Dexamples=false -Dtests=false -Dbinaries=true -Dlibblas= -Dliblapack= + meson setup builddir_int64 --buildtype=debug -Dquadruple=true -Dint64=true -Dexamples=false -Dtests=false -Dbinaries=true -Dlibblas= -Dliblapack= - name: Build GALAHAD shell: bash diff --git a/GALAHAD.jl/README.md b/GALAHAD.jl/README.md index cf510e6dc8..77b13c16c5 100644 --- a/GALAHAD.jl/README.md +++ b/GALAHAD.jl/README.md @@ -19,7 +19,7 @@ Documentation is available online from [https://ralna.github.io/galahad_docs/htm ## Environment variables -Note that the following environment variables must be set before starting Julia for the default sparse linear solver `SSIDS`: +Note that the following environment variables must be set before starting Julia for the default sparse linear solver `SLBLT`: ```raw export OMP_CANCELLATION=TRUE export OMP_PROC_BIND=TRUE diff --git a/GALAHAD.jl/gen/README.md b/GALAHAD.jl/gen/README.md index a143386f77..b430824ff6 100644 --- a/GALAHAD.jl/gen/README.md +++ b/GALAHAD.jl/gen/README.md @@ -109,7 +109,7 @@ The possible values for `library` are: - `"sllsb"`; - `"sls"`; - `"snls"`; -- `"ssids`; +- `"slblt`; - `"ssls`; - `"trb"`; - `"trek"`; @@ -119,7 +119,7 @@ The possible values for `library` are: - `"uls"`; - `"warm"`; - `"wcp"`; -- `"ssids"`; +- `"slblt"`; - `"hsl"`. The Julia wrappers are generated in the directory `GALAHAD.jl/src/wrappers`. diff --git a/GALAHAD.jl/gen/examples.jl b/GALAHAD.jl/gen/examples.jl index d5940307a4..b4ba48709d 100644 --- a/GALAHAD.jl/gen/examples.jl +++ b/GALAHAD.jl/gen/examples.jl @@ -215,7 +215,7 @@ function main(name::String) (name == "sllsb") && examples("sllsb" , "tf") (name == "sls") && examples("sls" , "tf") (name == "snls") && examples("snls" , "tf") - (name == "ssids") && examples("ssids" , "tf") + (name == "slblt") && examples("slblt" , "tf") (name == "ssls") && examples("ssls" , "tf") (name == "trb") && examples("trb" , "tf") (name == "trek") && examples("trek" , "tf") diff --git a/GALAHAD.jl/gen/galahad_c.jl b/GALAHAD.jl/gen/galahad_c.jl index a09b1df338..ea8f388deb 100644 --- a/GALAHAD.jl/gen/galahad_c.jl +++ b/GALAHAD.jl/gen/galahad_c.jl @@ -224,7 +224,7 @@ end function generate_galahad_c() ordered_packages = ("bsc", "convert", "fit", "glrt", "gls", "gltr", "hash", "hsl", "ir", "l2rt", "lhs", "lms", "lsrt", "lstr", "nodend", "presolve", "roots", "rpd", "scu", "sec", - "sha", "sils", "ugo", "ssids", "sls", "rqs", "dps", "psls", "arc", "trs", + "sha", "sils", "ugo", "slblt", "sls", "rqs", "dps", "psls", "arc", "trs", "trb", "bgo", "uls", "sbls", "blls", "bqp", "fdc", "cro", "bqpb", "ccqp", "cqp", "clls", "dgo", "dqp", "eqp", "lpa", "lpb", "lsqp", "nls", "qpa", "qpb", "slls", "nrek", "trek", "tru", "wcp", "llsr", "llst", "bllsb", "ssls", "sllsb", "bnls", diff --git a/GALAHAD.jl/gen/rewriter.jl b/GALAHAD.jl/gen/rewriter.jl index 0f42f3442e..c9db2c3184 100644 --- a/GALAHAD.jl/gen/rewriter.jl +++ b/GALAHAD.jl/gen/rewriter.jl @@ -5,7 +5,7 @@ packages = ("arc", "bgo", "blls", "bllsb", "bnls", "bqp", "bqpb", "bsc", "ir", "l2rt", "lhs", "llsr", "llst", "lms", "lpa", "lpb", "lsqp", "lsrt", "lstr", "nls", "nodend", "nrek", "presolve", "psls", "qpa", "qpb", "roots", "rpd", "rqs", "sbls", "scu", - "sec", "sha", "sils", "slls", "sllsb", "sls", "snls", "ssids", + "sec", "sha", "sils", "slls", "sllsb", "sls", "snls", "slblt", "ssls", "trb", "trek", "trs", "tru", "ugo", "uls", "version", "wcp") callbacks = ("galahad_f", "galahad_g", "galahad_h", "galahad_prec", "galahad_hprod", @@ -47,7 +47,7 @@ nonparametric_structures_float = ("bqp_time_type", "bsc_control_type", "convert_ # Structures that don't have a field with rpc_ but have an inner structure with rpc_ as a field. special_structures_float = ("convert_inform_type", "cro_inform_type", "lms_inform_type", "ugo_inform_type", "uls_inform_type", "nodend_inform_type", - "ssids_inform_type", "ssls_inform_type", "ssls_control_type") + "slblt_inform_type", "ssls_inform_type", "ssls_control_type") hsl_structures = ("ma48_control", "ma48_ainfo", "ma48_finfo", "ma48_sinfo", "ma57_control", "ma57_ainfo", "ma57_finfo", "ma57_sinfo", "ma77_control", "ma77_info", diff --git a/GALAHAD.jl/gen/wrapper.jl b/GALAHAD.jl/gen/wrapper.jl index f68352427c..9738768d91 100644 --- a/GALAHAD.jl/gen/wrapper.jl +++ b/GALAHAD.jl/gen/wrapper.jl @@ -193,7 +193,7 @@ function main(name::String="all"; optimized::Bool=true) (name == "all" || name == "sllsb") && wrapper("sllsb", ["$galahad/galahad_sllsb.h"], optimized, run_sif=true, run_qplib=false) (name == "all" || name == "sls") && wrapper("sls", ["$galahad/galahad_sls.h"], optimized, run_sif=true, run_qplib=false) (name == "all" || name == "snls") && wrapper("snls", ["$galahad/galahad_snls.h"], optimized, run_sif=true, run_qplib=false) - (name == "all" || name == "ssids") && wrapper("ssids", ["$galahad/galahad_ssids.h"], optimized, run_sif=false, run_qplib=false) + (name == "all" || name == "slblt") && wrapper("slblt", ["$galahad/galahad_slblt.h"], optimized, run_sif=false, run_qplib=false) (name == "all" || name == "ssls") && wrapper("ssls", ["$galahad/galahad_ssls.h"], optimized, run_sif=true, run_qplib=false) (name == "all" || name == "trb") && wrapper("trb", ["$galahad/galahad_trb.h"], optimized, run_sif=true, run_qplib=false) (name == "all" || name == "trek") && wrapper("trek", ["$galahad/galahad_trek.h"], optimized, run_sif=true, run_qplib=false) diff --git a/GALAHAD.jl/src/GALAHAD.jl b/GALAHAD.jl/src/GALAHAD.jl index 200a433a58..bfd55abcde 100644 --- a/GALAHAD.jl/src/GALAHAD.jl +++ b/GALAHAD.jl/src/GALAHAD.jl @@ -82,8 +82,8 @@ include("wrappers/qp.jl") include("wrappers/qpc.jl") include("wrappers/warm.jl") -# ssids requires nodend. -include("wrappers/ssids.jl") +# slblt requires nodend. +include("wrappers/slblt.jl") # sls requires sils, nodend. include("wrappers/sls.jl") diff --git a/GALAHAD.jl/src/wrappers/ssids.jl b/GALAHAD.jl/src/wrappers/slblt.jl similarity index 67% rename from GALAHAD.jl/src/wrappers/ssids.jl rename to GALAHAD.jl/src/wrappers/slblt.jl index 7dceb70563..ed85f46d0e 100644 --- a/GALAHAD.jl/src/wrappers/ssids.jl +++ b/GALAHAD.jl/src/wrappers/slblt.jl @@ -1,6 +1,6 @@ -export ssids_control_type +export slblt_control_type -struct ssids_control_type{T,INT} +struct slblt_control_type{T,INT} array_base::INT print_level::INT unit_diagnostics::INT @@ -9,28 +9,23 @@ struct ssids_control_type{T,INT} ordering::INT nemin::INT ignore_numa::Bool - use_gpu::Bool - gpu_only::Bool - min_gpu_work::Int64 max_load_inbalance::Float32 - gpu_perf_coeff::Float32 scaling::INT small_subtree_threshold::Int64 - cpu_block_size::INT + block_size::INT action::Bool pivot_method::INT small::T u::T nodend_control::nodend_control_type{INT} - nstream::INT multiplier::T min_loadbalance::Float32 failed_pivot_method::INT end -export ssids_inform_type +export slblt_inform_type -struct ssids_inform_type{T,INT} +struct slblt_inform_type{T,INT} flag::INT matrix_dup::INT matrix_missing_diag::INT @@ -46,897 +41,894 @@ struct ssids_inform_type{T,INT} num_sup::INT num_two::INT stat::INT - cuda_error::INT - cublas_error::INT nodend_inform::nodend_inform_type{T,INT} not_first_pass::INT not_second_pass::INT nparts::INT - cpu_flops::Int64 - gpu_flops::Int64 + flops::Int64 end -export ssids_default_control +export slblt_default_control -function ssids_default_control(::Type{Float32}, ::Type{Int32}, control) - @ccall libgalahad_single.ssids_default_control_s(control::Ptr{ssids_control_type{Float32, +function slblt_default_control(::Type{Float32}, ::Type{Int32}, control) + @ccall libgalahad_single.slblt_default_control_s(control::Ptr{slblt_control_type{Float32, Int32}})::Cvoid end -function ssids_default_control(::Type{Float32}, ::Type{Int64}, control) - @ccall libgalahad_single_64.ssids_default_control_s_64(control::Ptr{ssids_control_type{Float32, +function slblt_default_control(::Type{Float32}, ::Type{Int64}, control) + @ccall libgalahad_single_64.slblt_default_control_s_64(control::Ptr{slblt_control_type{Float32, Int64}})::Cvoid end -function ssids_default_control(::Type{Float64}, ::Type{Int32}, control) - @ccall libgalahad_double.ssids_default_control(control::Ptr{ssids_control_type{Float64, +function slblt_default_control(::Type{Float64}, ::Type{Int32}, control) + @ccall libgalahad_double.slblt_default_control(control::Ptr{slblt_control_type{Float64, Int32}})::Cvoid end -function ssids_default_control(::Type{Float64}, ::Type{Int64}, control) - @ccall libgalahad_double_64.ssids_default_control_64(control::Ptr{ssids_control_type{Float64, +function slblt_default_control(::Type{Float64}, ::Type{Int64}, control) + @ccall libgalahad_double_64.slblt_default_control_64(control::Ptr{slblt_control_type{Float64, Int64}})::Cvoid end -function ssids_default_control(::Type{Float128}, ::Type{Int32}, control) - @ccall libgalahad_quadruple.ssids_default_control_q(control::Ptr{ssids_control_type{Float128, +function slblt_default_control(::Type{Float128}, ::Type{Int32}, control) + @ccall libgalahad_quadruple.slblt_default_control_q(control::Ptr{slblt_control_type{Float128, Int32}})::Cvoid end -function ssids_default_control(::Type{Float128}, ::Type{Int64}, control) - @ccall libgalahad_quadruple_64.ssids_default_control_q_64(control::Ptr{ssids_control_type{Float128, +function slblt_default_control(::Type{Float128}, ::Type{Int64}, control) + @ccall libgalahad_quadruple_64.slblt_default_control_q_64(control::Ptr{slblt_control_type{Float128, Int64}})::Cvoid end -export ssids_analyse +export slblt_analyse -function ssids_analyse(::Type{Float32}, ::Type{Int32}, check, n, order, ptr, +function slblt_analyse(::Type{Float32}, ::Type{Int32}, check, n, order, ptr, row, val, akeep, control, inform) - @ccall libgalahad_single.ssids_analyse_s(check::Bool, n::Int32, + @ccall libgalahad_single.slblt_analyse_s(check::Bool, n::Int32, order::Ptr{Int32}, ptr::Ptr{Int64}, row::Ptr{Int32}, val::Ptr{Float32}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int32}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int32}})::Cvoid end -function ssids_analyse(::Type{Float32}, ::Type{Int64}, check, n, order, ptr, +function slblt_analyse(::Type{Float32}, ::Type{Int64}, check, n, order, ptr, row, val, akeep, control, inform) - @ccall libgalahad_single_64.ssids_analyse_s_64(check::Bool, n::Int64, + @ccall libgalahad_single_64.slblt_analyse_s_64(check::Bool, n::Int64, order::Ptr{Int64}, ptr::Ptr{Int64}, row::Ptr{Int64}, val::Ptr{Float32}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int64}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int64}})::Cvoid end -function ssids_analyse(::Type{Float64}, ::Type{Int32}, check, n, order, ptr, +function slblt_analyse(::Type{Float64}, ::Type{Int32}, check, n, order, ptr, row, val, akeep, control, inform) - @ccall libgalahad_double.ssids_analyse(check::Bool, n::Int32, + @ccall libgalahad_double.slblt_analyse(check::Bool, n::Int32, order::Ptr{Int32}, ptr::Ptr{Int64}, row::Ptr{Int32}, val::Ptr{Float64}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int32}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int32}})::Cvoid end -function ssids_analyse(::Type{Float64}, ::Type{Int64}, check, n, order, ptr, +function slblt_analyse(::Type{Float64}, ::Type{Int64}, check, n, order, ptr, row, val, akeep, control, inform) - @ccall libgalahad_double_64.ssids_analyse_64(check::Bool, n::Int64, + @ccall libgalahad_double_64.slblt_analyse_64(check::Bool, n::Int64, order::Ptr{Int64}, ptr::Ptr{Int64}, row::Ptr{Int64}, val::Ptr{Float64}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int64}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int64}})::Cvoid end -function ssids_analyse(::Type{Float128}, ::Type{Int32}, check, n, order, ptr, +function slblt_analyse(::Type{Float128}, ::Type{Int32}, check, n, order, ptr, row, val, akeep, control, inform) - @ccall libgalahad_quadruple.ssids_analyse_q(check::Bool, n::Int32, + @ccall libgalahad_quadruple.slblt_analyse_q(check::Bool, n::Int32, order::Ptr{Int32}, ptr::Ptr{Int64}, row::Ptr{Int32}, val::Ptr{Float128}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int32}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int32}})::Cvoid end -function ssids_analyse(::Type{Float128}, ::Type{Int64}, check, n, order, ptr, +function slblt_analyse(::Type{Float128}, ::Type{Int64}, check, n, order, ptr, row, val, akeep, control, inform) - @ccall libgalahad_quadruple_64.ssids_analyse_q_64(check::Bool, n::Int64, + @ccall libgalahad_quadruple_64.slblt_analyse_q_64(check::Bool, n::Int64, order::Ptr{Int64}, ptr::Ptr{Int64}, row::Ptr{Int64}, val::Ptr{Float128}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int64}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int64}})::Cvoid end -export ssids_analyse_ptr32 +export slblt_analyse_ptr32 -function ssids_analyse_ptr32(::Type{Float32}, ::Type{Int32}, check, n, order, +function slblt_analyse_ptr32(::Type{Float32}, ::Type{Int32}, check, n, order, ptr, row, val, akeep, control, inform) - @ccall libgalahad_single.ssids_analyse_ptr32_s(check::Bool, n::Int32, + @ccall libgalahad_single.slblt_analyse_ptr32_s(check::Bool, n::Int32, order::Ptr{Int32}, ptr::Ptr{Int32}, row::Ptr{Int32}, val::Ptr{Float32}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int32}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int32}})::Cvoid end -function ssids_analyse_ptr32(::Type{Float32}, ::Type{Int64}, check, n, order, +function slblt_analyse_ptr32(::Type{Float32}, ::Type{Int64}, check, n, order, ptr, row, val, akeep, control, inform) - @ccall libgalahad_single_64.ssids_analyse_ptr32_s_64(check::Bool, n::Int64, + @ccall libgalahad_single_64.slblt_analyse_ptr32_s_64(check::Bool, n::Int64, order::Ptr{Int64}, ptr::Ptr{Int64}, row::Ptr{Int64}, val::Ptr{Float32}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int64}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int64}})::Cvoid end -function ssids_analyse_ptr32(::Type{Float64}, ::Type{Int32}, check, n, order, +function slblt_analyse_ptr32(::Type{Float64}, ::Type{Int32}, check, n, order, ptr, row, val, akeep, control, inform) - @ccall libgalahad_double.ssids_analyse_ptr32(check::Bool, n::Int32, + @ccall libgalahad_double.slblt_analyse_ptr32(check::Bool, n::Int32, order::Ptr{Int32}, ptr::Ptr{Int32}, row::Ptr{Int32}, val::Ptr{Float64}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int32}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int32}})::Cvoid end -function ssids_analyse_ptr32(::Type{Float64}, ::Type{Int64}, check, n, order, +function slblt_analyse_ptr32(::Type{Float64}, ::Type{Int64}, check, n, order, ptr, row, val, akeep, control, inform) - @ccall libgalahad_double_64.ssids_analyse_ptr32_64(check::Bool, n::Int64, + @ccall libgalahad_double_64.slblt_analyse_ptr32_64(check::Bool, n::Int64, order::Ptr{Int64}, ptr::Ptr{Int64}, row::Ptr{Int64}, val::Ptr{Float64}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int64}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int64}})::Cvoid end -function ssids_analyse_ptr32(::Type{Float128}, ::Type{Int32}, check, n, order, +function slblt_analyse_ptr32(::Type{Float128}, ::Type{Int32}, check, n, order, ptr, row, val, akeep, control, inform) - @ccall libgalahad_quadruple.ssids_analyse_ptr32_q(check::Bool, n::Int32, + @ccall libgalahad_quadruple.slblt_analyse_ptr32_q(check::Bool, n::Int32, order::Ptr{Int32}, ptr::Ptr{Int32}, row::Ptr{Int32}, val::Ptr{Float128}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int32}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int32}})::Cvoid end -function ssids_analyse_ptr32(::Type{Float128}, ::Type{Int64}, check, n, order, +function slblt_analyse_ptr32(::Type{Float128}, ::Type{Int64}, check, n, order, ptr, row, val, akeep, control, inform) - @ccall libgalahad_quadruple_64.ssids_analyse_ptr32_q_64(check::Bool, n::Int64, + @ccall libgalahad_quadruple_64.slblt_analyse_ptr32_q_64(check::Bool, n::Int64, order::Ptr{Int64}, ptr::Ptr{Int64}, row::Ptr{Int64}, val::Ptr{Float128}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int64}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int64}})::Cvoid end -export ssids_analyse_coord +export slblt_analyse_coord -function ssids_analyse_coord(::Type{Float32}, ::Type{Int32}, n, order, ne, row, +function slblt_analyse_coord(::Type{Float32}, ::Type{Int32}, n, order, ne, row, col, val, akeep, control, inform) - @ccall libgalahad_single.ssids_analyse_coord_s(n::Int32, order::Ptr{Int32}, + @ccall libgalahad_single.slblt_analyse_coord_s(n::Int32, order::Ptr{Int32}, ne::Int64, row::Ptr{Int32}, col::Ptr{Int32}, val::Ptr{Float32}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int32}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int32}})::Cvoid end -function ssids_analyse_coord(::Type{Float32}, ::Type{Int64}, n, order, ne, row, +function slblt_analyse_coord(::Type{Float32}, ::Type{Int64}, n, order, ne, row, col, val, akeep, control, inform) - @ccall libgalahad_single_64.ssids_analyse_coord_s_64(n::Int64, + @ccall libgalahad_single_64.slblt_analyse_coord_s_64(n::Int64, order::Ptr{Int64}, ne::Int64, row::Ptr{Int64}, col::Ptr{Int64}, val::Ptr{Float32}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int64}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int64}})::Cvoid end -function ssids_analyse_coord(::Type{Float64}, ::Type{Int32}, n, order, ne, row, +function slblt_analyse_coord(::Type{Float64}, ::Type{Int32}, n, order, ne, row, col, val, akeep, control, inform) - @ccall libgalahad_double.ssids_analyse_coord(n::Int32, order::Ptr{Int32}, + @ccall libgalahad_double.slblt_analyse_coord(n::Int32, order::Ptr{Int32}, ne::Int64, row::Ptr{Int32}, col::Ptr{Int32}, val::Ptr{Float64}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int32}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int32}})::Cvoid end -function ssids_analyse_coord(::Type{Float64}, ::Type{Int64}, n, order, ne, row, +function slblt_analyse_coord(::Type{Float64}, ::Type{Int64}, n, order, ne, row, col, val, akeep, control, inform) - @ccall libgalahad_double_64.ssids_analyse_coord_64(n::Int64, + @ccall libgalahad_double_64.slblt_analyse_coord_64(n::Int64, order::Ptr{Int64}, ne::Int64, row::Ptr{Int64}, col::Ptr{Int64}, val::Ptr{Float64}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int64}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int64}})::Cvoid end -function ssids_analyse_coord(::Type{Float128}, ::Type{Int32}, n, order, ne, row, +function slblt_analyse_coord(::Type{Float128}, ::Type{Int32}, n, order, ne, row, col, val, akeep, control, inform) - @ccall libgalahad_quadruple.ssids_analyse_coord_q(n::Int32, order::Ptr{Int32}, + @ccall libgalahad_quadruple.slblt_analyse_coord_q(n::Int32, order::Ptr{Int32}, ne::Int64, row::Ptr{Int32}, col::Ptr{Int32}, val::Ptr{Float128}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int32}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int32}})::Cvoid end -function ssids_analyse_coord(::Type{Float128}, ::Type{Int64}, n, order, ne, row, +function slblt_analyse_coord(::Type{Float128}, ::Type{Int64}, n, order, ne, row, col, val, akeep, control, inform) - @ccall libgalahad_quadruple_64.ssids_analyse_coord_q_64(n::Int64, + @ccall libgalahad_quadruple_64.slblt_analyse_coord_q_64(n::Int64, order::Ptr{Int64}, ne::Int64, row::Ptr{Int64}, col::Ptr{Int64}, val::Ptr{Float128}, akeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int64}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int64}})::Cvoid end -export ssids_factor +export slblt_factor -function ssids_factor(::Type{Float32}, ::Type{Int32}, posdef, ptr, row, val, +function slblt_factor(::Type{Float32}, ::Type{Int32}, posdef, ptr, row, val, scale, akeep, fkeep, control, inform) - @ccall libgalahad_single.ssids_factor_s(posdef::Bool, ptr::Ptr{Int64}, + @ccall libgalahad_single.slblt_factor_s(posdef::Bool, ptr::Ptr{Int64}, row::Ptr{Int32}, val::Ptr{Float32}, scale::Ptr{Float32}, akeep::Ptr{Cvoid}, fkeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int32}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int32}})::Cvoid end -function ssids_factor(::Type{Float32}, ::Type{Int64}, posdef, ptr, row, val, +function slblt_factor(::Type{Float32}, ::Type{Int64}, posdef, ptr, row, val, scale, akeep, fkeep, control, inform) - @ccall libgalahad_single_64.ssids_factor_s_64(posdef::Bool, ptr::Ptr{Int64}, + @ccall libgalahad_single_64.slblt_factor_s_64(posdef::Bool, ptr::Ptr{Int64}, row::Ptr{Int64}, val::Ptr{Float32}, scale::Ptr{Float32}, akeep::Ptr{Cvoid}, fkeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int64}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int64}})::Cvoid end -function ssids_factor(::Type{Float64}, ::Type{Int32}, posdef, ptr, row, val, +function slblt_factor(::Type{Float64}, ::Type{Int32}, posdef, ptr, row, val, scale, akeep, fkeep, control, inform) - @ccall libgalahad_double.ssids_factor(posdef::Bool, ptr::Ptr{Int64}, + @ccall libgalahad_double.slblt_factor(posdef::Bool, ptr::Ptr{Int64}, row::Ptr{Int32}, val::Ptr{Float64}, scale::Ptr{Float64}, akeep::Ptr{Cvoid}, fkeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int32}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int32}})::Cvoid end -function ssids_factor(::Type{Float64}, ::Type{Int64}, posdef, ptr, row, val, +function slblt_factor(::Type{Float64}, ::Type{Int64}, posdef, ptr, row, val, scale, akeep, fkeep, control, inform) - @ccall libgalahad_double_64.ssids_factor_64(posdef::Bool, ptr::Ptr{Int64}, + @ccall libgalahad_double_64.slblt_factor_64(posdef::Bool, ptr::Ptr{Int64}, row::Ptr{Int64}, val::Ptr{Float64}, scale::Ptr{Float64}, akeep::Ptr{Cvoid}, fkeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int64}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int64}})::Cvoid end -function ssids_factor(::Type{Float128}, ::Type{Int32}, posdef, ptr, row, val, +function slblt_factor(::Type{Float128}, ::Type{Int32}, posdef, ptr, row, val, scale, akeep, fkeep, control, inform) - @ccall libgalahad_quadruple.ssids_factor_q(posdef::Bool, ptr::Ptr{Int64}, + @ccall libgalahad_quadruple.slblt_factor_q(posdef::Bool, ptr::Ptr{Int64}, row::Ptr{Int32}, val::Ptr{Float128}, scale::Ptr{Float128}, akeep::Ptr{Cvoid}, fkeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int32}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int32}})::Cvoid end -function ssids_factor(::Type{Float128}, ::Type{Int64}, posdef, ptr, row, val, +function slblt_factor(::Type{Float128}, ::Type{Int64}, posdef, ptr, row, val, scale, akeep, fkeep, control, inform) - @ccall libgalahad_quadruple_64.ssids_factor_q_64(posdef::Bool, + @ccall libgalahad_quadruple_64.slblt_factor_q_64(posdef::Bool, ptr::Ptr{Int64}, row::Ptr{Int64}, val::Ptr{Float128}, scale::Ptr{Float128}, akeep::Ptr{Cvoid}, fkeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int64}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int64}})::Cvoid end -export ssids_factor_ptr32 +export slblt_factor_ptr32 -function ssids_factor_ptr32(::Type{Float32}, ::Type{Int32}, posdef, ptr, row, +function slblt_factor_ptr32(::Type{Float32}, ::Type{Int32}, posdef, ptr, row, val, scale, akeep, fkeep, control, inform) - @ccall libgalahad_single.ssids_factor_ptr32_s(posdef::Bool, ptr::Ptr{Int32}, + @ccall libgalahad_single.slblt_factor_ptr32_s(posdef::Bool, ptr::Ptr{Int32}, row::Ptr{Int32}, val::Ptr{Float32}, scale::Ptr{Float32}, akeep::Ptr{Cvoid}, fkeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int32}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int32}})::Cvoid end -function ssids_factor_ptr32(::Type{Float32}, ::Type{Int64}, posdef, ptr, row, +function slblt_factor_ptr32(::Type{Float32}, ::Type{Int64}, posdef, ptr, row, val, scale, akeep, fkeep, control, inform) - @ccall libgalahad_single_64.ssids_factor_ptr32_s_64(posdef::Bool, + @ccall libgalahad_single_64.slblt_factor_ptr32_s_64(posdef::Bool, ptr::Ptr{Int64}, row::Ptr{Int64}, val::Ptr{Float32}, scale::Ptr{Float32}, akeep::Ptr{Cvoid}, fkeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int64}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int64}})::Cvoid end -function ssids_factor_ptr32(::Type{Float64}, ::Type{Int32}, posdef, ptr, row, +function slblt_factor_ptr32(::Type{Float64}, ::Type{Int32}, posdef, ptr, row, val, scale, akeep, fkeep, control, inform) - @ccall libgalahad_double.ssids_factor_ptr32(posdef::Bool, ptr::Ptr{Int32}, + @ccall libgalahad_double.slblt_factor_ptr32(posdef::Bool, ptr::Ptr{Int32}, row::Ptr{Int32}, val::Ptr{Float64}, scale::Ptr{Float64}, akeep::Ptr{Cvoid}, fkeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int32}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int32}})::Cvoid end -function ssids_factor_ptr32(::Type{Float64}, ::Type{Int64}, posdef, ptr, row, +function slblt_factor_ptr32(::Type{Float64}, ::Type{Int64}, posdef, ptr, row, val, scale, akeep, fkeep, control, inform) - @ccall libgalahad_double_64.ssids_factor_ptr32_64(posdef::Bool, + @ccall libgalahad_double_64.slblt_factor_ptr32_64(posdef::Bool, ptr::Ptr{Int64}, row::Ptr{Int64}, val::Ptr{Float64}, scale::Ptr{Float64}, akeep::Ptr{Cvoid}, fkeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int64}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int64}})::Cvoid end -function ssids_factor_ptr32(::Type{Float128}, ::Type{Int32}, posdef, ptr, row, +function slblt_factor_ptr32(::Type{Float128}, ::Type{Int32}, posdef, ptr, row, val, scale, akeep, fkeep, control, inform) - @ccall libgalahad_quadruple.ssids_factor_ptr32_q(posdef::Bool, + @ccall libgalahad_quadruple.slblt_factor_ptr32_q(posdef::Bool, ptr::Ptr{Int32}, row::Ptr{Int32}, val::Ptr{Float128}, scale::Ptr{Float128}, akeep::Ptr{Cvoid}, fkeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int32}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int32}})::Cvoid end -function ssids_factor_ptr32(::Type{Float128}, ::Type{Int64}, posdef, ptr, row, +function slblt_factor_ptr32(::Type{Float128}, ::Type{Int64}, posdef, ptr, row, val, scale, akeep, fkeep, control, inform) - @ccall libgalahad_quadruple_64.ssids_factor_ptr32_q_64(posdef::Bool, + @ccall libgalahad_quadruple_64.slblt_factor_ptr32_q_64(posdef::Bool, ptr::Ptr{Int64}, row::Ptr{Int64}, val::Ptr{Float128}, scale::Ptr{Float128}, akeep::Ptr{Cvoid}, fkeep::Ptr{Ptr{Cvoid}}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int64}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int64}})::Cvoid end -export ssids_solve1 +export slblt_solve1 -function ssids_solve1(::Type{Float32}, ::Type{Int32}, job, x1, akeep, fkeep, +function slblt_solve1(::Type{Float32}, ::Type{Int32}, job, x1, akeep, fkeep, control, inform) - @ccall libgalahad_single.ssids_solve1_s(job::Int32, x1::Ptr{Float32}, + @ccall libgalahad_single.slblt_solve1_s(job::Int32, x1::Ptr{Float32}, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int32}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int32}})::Cvoid end -function ssids_solve1(::Type{Float32}, ::Type{Int64}, job, x1, akeep, fkeep, +function slblt_solve1(::Type{Float32}, ::Type{Int64}, job, x1, akeep, fkeep, control, inform) - @ccall libgalahad_single_64.ssids_solve1_s_64(job::Int64, x1::Ptr{Float32}, + @ccall libgalahad_single_64.slblt_solve1_s_64(job::Int64, x1::Ptr{Float32}, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int64}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int64}})::Cvoid end -function ssids_solve1(::Type{Float64}, ::Type{Int32}, job, x1, akeep, fkeep, +function slblt_solve1(::Type{Float64}, ::Type{Int32}, job, x1, akeep, fkeep, control, inform) - @ccall libgalahad_double.ssids_solve1(job::Int32, x1::Ptr{Float64}, + @ccall libgalahad_double.slblt_solve1(job::Int32, x1::Ptr{Float64}, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int32}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int32}})::Cvoid end -function ssids_solve1(::Type{Float64}, ::Type{Int64}, job, x1, akeep, fkeep, +function slblt_solve1(::Type{Float64}, ::Type{Int64}, job, x1, akeep, fkeep, control, inform) - @ccall libgalahad_double_64.ssids_solve1_64(job::Int64, x1::Ptr{Float64}, + @ccall libgalahad_double_64.slblt_solve1_64(job::Int64, x1::Ptr{Float64}, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int64}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int64}})::Cvoid end -function ssids_solve1(::Type{Float128}, ::Type{Int32}, job, x1, akeep, fkeep, +function slblt_solve1(::Type{Float128}, ::Type{Int32}, job, x1, akeep, fkeep, control, inform) - @ccall libgalahad_quadruple.ssids_solve1_q(job::Int32, x1::Ptr{Float128}, + @ccall libgalahad_quadruple.slblt_solve1_q(job::Int32, x1::Ptr{Float128}, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int32}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int32}})::Cvoid end -function ssids_solve1(::Type{Float128}, ::Type{Int64}, job, x1, akeep, fkeep, +function slblt_solve1(::Type{Float128}, ::Type{Int64}, job, x1, akeep, fkeep, control, inform) - @ccall libgalahad_quadruple_64.ssids_solve1_q_64(job::Int64, + @ccall libgalahad_quadruple_64.slblt_solve1_q_64(job::Int64, x1::Ptr{Float128}, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int64}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int64}})::Cvoid end -export ssids_solve +export slblt_solve -function ssids_solve(::Type{Float32}, ::Type{Int32}, job, nrhs, x, ldx, akeep, +function slblt_solve(::Type{Float32}, ::Type{Int32}, job, nrhs, x, ldx, akeep, fkeep, control, inform) - @ccall libgalahad_single.ssids_solve_s(job::Int32, nrhs::Int32, + @ccall libgalahad_single.slblt_solve_s(job::Int32, nrhs::Int32, x::Ptr{Float32}, ldx::Int32, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int32}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int32}})::Cvoid end -function ssids_solve(::Type{Float32}, ::Type{Int64}, job, nrhs, x, ldx, akeep, +function slblt_solve(::Type{Float32}, ::Type{Int64}, job, nrhs, x, ldx, akeep, fkeep, control, inform) - @ccall libgalahad_single_64.ssids_solve_s_64(job::Int64, nrhs::Int64, + @ccall libgalahad_single_64.slblt_solve_s_64(job::Int64, nrhs::Int64, x::Ptr{Float32}, ldx::Int64, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int64}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int64}})::Cvoid end -function ssids_solve(::Type{Float64}, ::Type{Int32}, job, nrhs, x, ldx, akeep, +function slblt_solve(::Type{Float64}, ::Type{Int32}, job, nrhs, x, ldx, akeep, fkeep, control, inform) - @ccall libgalahad_double.ssids_solve(job::Int32, nrhs::Int32, x::Ptr{Float64}, + @ccall libgalahad_double.slblt_solve(job::Int32, nrhs::Int32, x::Ptr{Float64}, ldx::Int32, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int32}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int32}})::Cvoid end -function ssids_solve(::Type{Float64}, ::Type{Int64}, job, nrhs, x, ldx, akeep, +function slblt_solve(::Type{Float64}, ::Type{Int64}, job, nrhs, x, ldx, akeep, fkeep, control, inform) - @ccall libgalahad_double_64.ssids_solve_64(job::Int64, nrhs::Int64, + @ccall libgalahad_double_64.slblt_solve_64(job::Int64, nrhs::Int64, x::Ptr{Float64}, ldx::Int64, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int64}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int64}})::Cvoid end -function ssids_solve(::Type{Float128}, ::Type{Int32}, job, nrhs, x, ldx, akeep, +function slblt_solve(::Type{Float128}, ::Type{Int32}, job, nrhs, x, ldx, akeep, fkeep, control, inform) - @ccall libgalahad_quadruple.ssids_solve_q(job::Int32, nrhs::Int32, + @ccall libgalahad_quadruple.slblt_solve_q(job::Int32, nrhs::Int32, x::Ptr{Float128}, ldx::Int32, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int32}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int32}})::Cvoid end -function ssids_solve(::Type{Float128}, ::Type{Int64}, job, nrhs, x, ldx, akeep, +function slblt_solve(::Type{Float128}, ::Type{Int64}, job, nrhs, x, ldx, akeep, fkeep, control, inform) - @ccall libgalahad_quadruple_64.ssids_solve_q_64(job::Int64, nrhs::Int64, + @ccall libgalahad_quadruple_64.slblt_solve_q_64(job::Int64, nrhs::Int64, x::Ptr{Float128}, ldx::Int64, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int64}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int64}})::Cvoid end -export ssids_free_akeep +export slblt_free_akeep -function ssids_free_akeep(::Type{Float32}, ::Type{Int32}, akeep) - @ccall libgalahad_single.ssids_free_akeep_s(akeep::Ptr{Ptr{Cvoid}})::Int32 +function slblt_free_akeep(::Type{Float32}, ::Type{Int32}, akeep) + @ccall libgalahad_single.slblt_free_akeep_s(akeep::Ptr{Ptr{Cvoid}})::Int32 end -function ssids_free_akeep(::Type{Float32}, ::Type{Int64}, akeep) - @ccall libgalahad_single_64.ssids_free_akeep_s_64(akeep::Ptr{Ptr{Cvoid}})::Int64 +function slblt_free_akeep(::Type{Float32}, ::Type{Int64}, akeep) + @ccall libgalahad_single_64.slblt_free_akeep_s_64(akeep::Ptr{Ptr{Cvoid}})::Int64 end -function ssids_free_akeep(::Type{Float64}, ::Type{Int32}, akeep) - @ccall libgalahad_double.ssids_free_akeep(akeep::Ptr{Ptr{Cvoid}})::Int32 +function slblt_free_akeep(::Type{Float64}, ::Type{Int32}, akeep) + @ccall libgalahad_double.slblt_free_akeep(akeep::Ptr{Ptr{Cvoid}})::Int32 end -function ssids_free_akeep(::Type{Float64}, ::Type{Int64}, akeep) - @ccall libgalahad_double_64.ssids_free_akeep_64(akeep::Ptr{Ptr{Cvoid}})::Int64 +function slblt_free_akeep(::Type{Float64}, ::Type{Int64}, akeep) + @ccall libgalahad_double_64.slblt_free_akeep_64(akeep::Ptr{Ptr{Cvoid}})::Int64 end -function ssids_free_akeep(::Type{Float128}, ::Type{Int32}, akeep) - @ccall libgalahad_quadruple.ssids_free_akeep_q(akeep::Ptr{Ptr{Cvoid}})::Int32 +function slblt_free_akeep(::Type{Float128}, ::Type{Int32}, akeep) + @ccall libgalahad_quadruple.slblt_free_akeep_q(akeep::Ptr{Ptr{Cvoid}})::Int32 end -function ssids_free_akeep(::Type{Float128}, ::Type{Int64}, akeep) - @ccall libgalahad_quadruple_64.ssids_free_akeep_q_64(akeep::Ptr{Ptr{Cvoid}})::Int64 +function slblt_free_akeep(::Type{Float128}, ::Type{Int64}, akeep) + @ccall libgalahad_quadruple_64.slblt_free_akeep_q_64(akeep::Ptr{Ptr{Cvoid}})::Int64 end -export ssids_free_fkeep +export slblt_free_fkeep -function ssids_free_fkeep(::Type{Float32}, ::Type{Int32}, fkeep) - @ccall libgalahad_single.ssids_free_fkeep_s(fkeep::Ptr{Ptr{Cvoid}})::Int32 +function slblt_free_fkeep(::Type{Float32}, ::Type{Int32}, fkeep) + @ccall libgalahad_single.slblt_free_fkeep_s(fkeep::Ptr{Ptr{Cvoid}})::Int32 end -function ssids_free_fkeep(::Type{Float32}, ::Type{Int64}, fkeep) - @ccall libgalahad_single_64.ssids_free_fkeep_s_64(fkeep::Ptr{Ptr{Cvoid}})::Int64 +function slblt_free_fkeep(::Type{Float32}, ::Type{Int64}, fkeep) + @ccall libgalahad_single_64.slblt_free_fkeep_s_64(fkeep::Ptr{Ptr{Cvoid}})::Int64 end -function ssids_free_fkeep(::Type{Float64}, ::Type{Int32}, fkeep) - @ccall libgalahad_double.ssids_free_fkeep(fkeep::Ptr{Ptr{Cvoid}})::Int32 +function slblt_free_fkeep(::Type{Float64}, ::Type{Int32}, fkeep) + @ccall libgalahad_double.slblt_free_fkeep(fkeep::Ptr{Ptr{Cvoid}})::Int32 end -function ssids_free_fkeep(::Type{Float64}, ::Type{Int64}, fkeep) - @ccall libgalahad_double_64.ssids_free_fkeep_64(fkeep::Ptr{Ptr{Cvoid}})::Int64 +function slblt_free_fkeep(::Type{Float64}, ::Type{Int64}, fkeep) + @ccall libgalahad_double_64.slblt_free_fkeep_64(fkeep::Ptr{Ptr{Cvoid}})::Int64 end -function ssids_free_fkeep(::Type{Float128}, ::Type{Int32}, fkeep) - @ccall libgalahad_quadruple.ssids_free_fkeep_q(fkeep::Ptr{Ptr{Cvoid}})::Int32 +function slblt_free_fkeep(::Type{Float128}, ::Type{Int32}, fkeep) + @ccall libgalahad_quadruple.slblt_free_fkeep_q(fkeep::Ptr{Ptr{Cvoid}})::Int32 end -function ssids_free_fkeep(::Type{Float128}, ::Type{Int64}, fkeep) - @ccall libgalahad_quadruple_64.ssids_free_fkeep_q_64(fkeep::Ptr{Ptr{Cvoid}})::Int64 +function slblt_free_fkeep(::Type{Float128}, ::Type{Int64}, fkeep) + @ccall libgalahad_quadruple_64.slblt_free_fkeep_q_64(fkeep::Ptr{Ptr{Cvoid}})::Int64 end -export ssids_free +export slblt_free -function ssids_free(::Type{Float32}, ::Type{Int32}, akeep, fkeep) - @ccall libgalahad_single.ssids_free_s(akeep::Ptr{Ptr{Cvoid}}, +function slblt_free(::Type{Float32}, ::Type{Int32}, akeep, fkeep) + @ccall libgalahad_single.slblt_free_s(akeep::Ptr{Ptr{Cvoid}}, fkeep::Ptr{Ptr{Cvoid}})::Int32 end -function ssids_free(::Type{Float32}, ::Type{Int64}, akeep, fkeep) - @ccall libgalahad_single_64.ssids_free_s_64(akeep::Ptr{Ptr{Cvoid}}, +function slblt_free(::Type{Float32}, ::Type{Int64}, akeep, fkeep) + @ccall libgalahad_single_64.slblt_free_s_64(akeep::Ptr{Ptr{Cvoid}}, fkeep::Ptr{Ptr{Cvoid}})::Int64 end -function ssids_free(::Type{Float64}, ::Type{Int32}, akeep, fkeep) - @ccall libgalahad_double.ssids_free(akeep::Ptr{Ptr{Cvoid}}, +function slblt_free(::Type{Float64}, ::Type{Int32}, akeep, fkeep) + @ccall libgalahad_double.slblt_free(akeep::Ptr{Ptr{Cvoid}}, fkeep::Ptr{Ptr{Cvoid}})::Int32 end -function ssids_free(::Type{Float64}, ::Type{Int64}, akeep, fkeep) - @ccall libgalahad_double_64.ssids_free_64(akeep::Ptr{Ptr{Cvoid}}, +function slblt_free(::Type{Float64}, ::Type{Int64}, akeep, fkeep) + @ccall libgalahad_double_64.slblt_free_64(akeep::Ptr{Ptr{Cvoid}}, fkeep::Ptr{Ptr{Cvoid}})::Int64 end -function ssids_free(::Type{Float128}, ::Type{Int32}, akeep, fkeep) - @ccall libgalahad_quadruple.ssids_free_q(akeep::Ptr{Ptr{Cvoid}}, +function slblt_free(::Type{Float128}, ::Type{Int32}, akeep, fkeep) + @ccall libgalahad_quadruple.slblt_free_q(akeep::Ptr{Ptr{Cvoid}}, fkeep::Ptr{Ptr{Cvoid}})::Int32 end -function ssids_free(::Type{Float128}, ::Type{Int64}, akeep, fkeep) - @ccall libgalahad_quadruple_64.ssids_free_q_64(akeep::Ptr{Ptr{Cvoid}}, +function slblt_free(::Type{Float128}, ::Type{Int64}, akeep, fkeep) + @ccall libgalahad_quadruple_64.slblt_free_q_64(akeep::Ptr{Ptr{Cvoid}}, fkeep::Ptr{Ptr{Cvoid}})::Int64 end -export ssids_enquire_posdef +export slblt_enquire_posdef -function ssids_enquire_posdef(::Type{Float32}, ::Type{Int32}, akeep, fkeep, +function slblt_enquire_posdef(::Type{Float32}, ::Type{Int32}, akeep, fkeep, control, inform, d) - @ccall libgalahad_single.ssids_enquire_posdef_s(akeep::Ptr{Cvoid}, + @ccall libgalahad_single.slblt_enquire_posdef_s(akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int32}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int32}}, d::Ptr{Float32})::Cvoid end -function ssids_enquire_posdef(::Type{Float32}, ::Type{Int64}, akeep, fkeep, +function slblt_enquire_posdef(::Type{Float32}, ::Type{Int64}, akeep, fkeep, control, inform, d) - @ccall libgalahad_single_64.ssids_enquire_posdef_s_64(akeep::Ptr{Cvoid}, + @ccall libgalahad_single_64.slblt_enquire_posdef_s_64(akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int64}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int64}}, d::Ptr{Float32})::Cvoid end -function ssids_enquire_posdef(::Type{Float64}, ::Type{Int32}, akeep, fkeep, +function slblt_enquire_posdef(::Type{Float64}, ::Type{Int32}, akeep, fkeep, control, inform, d) - @ccall libgalahad_double.ssids_enquire_posdef(akeep::Ptr{Cvoid}, + @ccall libgalahad_double.slblt_enquire_posdef(akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int32}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int32}}, d::Ptr{Float64})::Cvoid end -function ssids_enquire_posdef(::Type{Float64}, ::Type{Int64}, akeep, fkeep, +function slblt_enquire_posdef(::Type{Float64}, ::Type{Int64}, akeep, fkeep, control, inform, d) - @ccall libgalahad_double_64.ssids_enquire_posdef_64(akeep::Ptr{Cvoid}, + @ccall libgalahad_double_64.slblt_enquire_posdef_64(akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int64}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int64}}, d::Ptr{Float64})::Cvoid end -function ssids_enquire_posdef(::Type{Float128}, ::Type{Int32}, akeep, fkeep, +function slblt_enquire_posdef(::Type{Float128}, ::Type{Int32}, akeep, fkeep, control, inform, d) - @ccall libgalahad_quadruple.ssids_enquire_posdef_q(akeep::Ptr{Cvoid}, + @ccall libgalahad_quadruple.slblt_enquire_posdef_q(akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int32}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int32}}, d::Ptr{Float128})::Cvoid end -function ssids_enquire_posdef(::Type{Float128}, ::Type{Int64}, akeep, fkeep, +function slblt_enquire_posdef(::Type{Float128}, ::Type{Int64}, akeep, fkeep, control, inform, d) - @ccall libgalahad_quadruple_64.ssids_enquire_posdef_q_64(akeep::Ptr{Cvoid}, + @ccall libgalahad_quadruple_64.slblt_enquire_posdef_q_64(akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int64}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int64}}, d::Ptr{Float128})::Cvoid end -export ssids_enquire_indef +export slblt_enquire_indef -function ssids_enquire_indef(::Type{Float32}, ::Type{Int32}, akeep, fkeep, +function slblt_enquire_indef(::Type{Float32}, ::Type{Int32}, akeep, fkeep, control, inform, piv_order, d) - @ccall libgalahad_single.ssids_enquire_indef_s(akeep::Ptr{Cvoid}, + @ccall libgalahad_single.slblt_enquire_indef_s(akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int32}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int32}}, piv_order::Ptr{Int32}, d::Ptr{Float32})::Cvoid end -function ssids_enquire_indef(::Type{Float32}, ::Type{Int64}, akeep, fkeep, +function slblt_enquire_indef(::Type{Float32}, ::Type{Int64}, akeep, fkeep, control, inform, piv_order, d) - @ccall libgalahad_single_64.ssids_enquire_indef_s_64(akeep::Ptr{Cvoid}, + @ccall libgalahad_single_64.slblt_enquire_indef_s_64(akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int64}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int64}}, piv_order::Ptr{Int64}, d::Ptr{Float32})::Cvoid end -function ssids_enquire_indef(::Type{Float64}, ::Type{Int32}, akeep, fkeep, +function slblt_enquire_indef(::Type{Float64}, ::Type{Int32}, akeep, fkeep, control, inform, piv_order, d) - @ccall libgalahad_double.ssids_enquire_indef(akeep::Ptr{Cvoid}, + @ccall libgalahad_double.slblt_enquire_indef(akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int32}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int32}}, piv_order::Ptr{Int32}, d::Ptr{Float64})::Cvoid end -function ssids_enquire_indef(::Type{Float64}, ::Type{Int64}, akeep, fkeep, +function slblt_enquire_indef(::Type{Float64}, ::Type{Int64}, akeep, fkeep, control, inform, piv_order, d) - @ccall libgalahad_double_64.ssids_enquire_indef_64(akeep::Ptr{Cvoid}, + @ccall libgalahad_double_64.slblt_enquire_indef_64(akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int64}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int64}}, piv_order::Ptr{Int64}, d::Ptr{Float64})::Cvoid end -function ssids_enquire_indef(::Type{Float128}, ::Type{Int32}, akeep, fkeep, +function slblt_enquire_indef(::Type{Float128}, ::Type{Int32}, akeep, fkeep, control, inform, piv_order, d) - @ccall libgalahad_quadruple.ssids_enquire_indef_q(akeep::Ptr{Cvoid}, + @ccall libgalahad_quadruple.slblt_enquire_indef_q(akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int32}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int32}}, piv_order::Ptr{Int32}, d::Ptr{Float128})::Cvoid end -function ssids_enquire_indef(::Type{Float128}, ::Type{Int64}, akeep, fkeep, +function slblt_enquire_indef(::Type{Float128}, ::Type{Int64}, akeep, fkeep, control, inform, piv_order, d) - @ccall libgalahad_quadruple_64.ssids_enquire_indef_q_64(akeep::Ptr{Cvoid}, + @ccall libgalahad_quadruple_64.slblt_enquire_indef_q_64(akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int64}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int64}}, piv_order::Ptr{Int64}, d::Ptr{Float128})::Cvoid end -export ssids_alter +export slblt_alter -function ssids_alter(::Type{Float32}, ::Type{Int32}, d, akeep, fkeep, control, +function slblt_alter(::Type{Float32}, ::Type{Int32}, d, akeep, fkeep, control, inform) - @ccall libgalahad_single.ssids_alter_s(d::Ptr{Float32}, akeep::Ptr{Cvoid}, + @ccall libgalahad_single.slblt_alter_s(d::Ptr{Float32}, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int32}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int32}})::Cvoid end -function ssids_alter(::Type{Float32}, ::Type{Int64}, d, akeep, fkeep, control, +function slblt_alter(::Type{Float32}, ::Type{Int64}, d, akeep, fkeep, control, inform) - @ccall libgalahad_single_64.ssids_alter_s_64(d::Ptr{Float32}, + @ccall libgalahad_single_64.slblt_alter_s_64(d::Ptr{Float32}, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float32, + control::Ptr{slblt_control_type{Float32, Int64}}, - inform::Ptr{ssids_inform_type{Float32, + inform::Ptr{slblt_inform_type{Float32, Int64}})::Cvoid end -function ssids_alter(::Type{Float64}, ::Type{Int32}, d, akeep, fkeep, control, +function slblt_alter(::Type{Float64}, ::Type{Int32}, d, akeep, fkeep, control, inform) - @ccall libgalahad_double.ssids_alter(d::Ptr{Float64}, akeep::Ptr{Cvoid}, + @ccall libgalahad_double.slblt_alter(d::Ptr{Float64}, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int32}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int32}})::Cvoid end -function ssids_alter(::Type{Float64}, ::Type{Int64}, d, akeep, fkeep, control, +function slblt_alter(::Type{Float64}, ::Type{Int64}, d, akeep, fkeep, control, inform) - @ccall libgalahad_double_64.ssids_alter_64(d::Ptr{Float64}, akeep::Ptr{Cvoid}, + @ccall libgalahad_double_64.slblt_alter_64(d::Ptr{Float64}, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float64, + control::Ptr{slblt_control_type{Float64, Int64}}, - inform::Ptr{ssids_inform_type{Float64, + inform::Ptr{slblt_inform_type{Float64, Int64}})::Cvoid end -function ssids_alter(::Type{Float128}, ::Type{Int32}, d, akeep, fkeep, control, +function slblt_alter(::Type{Float128}, ::Type{Int32}, d, akeep, fkeep, control, inform) - @ccall libgalahad_quadruple.ssids_alter_q(d::Ptr{Float128}, akeep::Ptr{Cvoid}, + @ccall libgalahad_quadruple.slblt_alter_q(d::Ptr{Float128}, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int32}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int32}})::Cvoid end -function ssids_alter(::Type{Float128}, ::Type{Int64}, d, akeep, fkeep, control, +function slblt_alter(::Type{Float128}, ::Type{Int64}, d, akeep, fkeep, control, inform) - @ccall libgalahad_quadruple_64.ssids_alter_q_64(d::Ptr{Float128}, + @ccall libgalahad_quadruple_64.slblt_alter_q_64(d::Ptr{Float128}, akeep::Ptr{Cvoid}, fkeep::Ptr{Cvoid}, - control::Ptr{ssids_control_type{Float128, + control::Ptr{slblt_control_type{Float128, Int64}}, - inform::Ptr{ssids_inform_type{Float128, + inform::Ptr{slblt_inform_type{Float128, Int64}})::Cvoid end diff --git a/GALAHAD.jl/src/wrappers/sls.jl b/GALAHAD.jl/src/wrappers/sls.jl index a8d39c948a..fd5e7d3260 100644 --- a/GALAHAD.jl/src/wrappers/sls.jl +++ b/GALAHAD.jl/src/wrappers/sls.jl @@ -135,7 +135,7 @@ struct sls_inform_type{T,INT} ma86_info::ma86_info{T,INT} ma87_info::ma87_info{T,INT} ma97_info::ma97_info{T,INT} - ssids_inform::ssids_inform_type{T,INT} + slblt_inform::slblt_inform_type{T,INT} nodend_inform::nodend_inform_type{T,INT} mc61_info::NTuple{10,INT} mc61_rinfo::NTuple{15,T} diff --git a/GALAHAD.jl/test/runtests.jl b/GALAHAD.jl/test/runtests.jl index 4c9bf551c9..ffe49159e5 100644 --- a/GALAHAD.jl/test/runtests.jl +++ b/GALAHAD.jl/test/runtests.jl @@ -55,11 +55,11 @@ include("test_scu.jl") include("test_sec.jl") include("test_sha.jl") include("test_sils.jl") +include("test_slblt.jl") include("test_slls.jl") include("test_sllsb.jl") include("test_sls.jl") include("test_snls.jl") -include("test_ssids.jl") include("test_ssls.jl") include("test_trb.jl") include("test_trek.jl") diff --git a/GALAHAD.jl/test/test_ssids.jl b/GALAHAD.jl/test/test_slblt.jl similarity index 67% rename from GALAHAD.jl/test/test_ssids.jl rename to GALAHAD.jl/test/test_slblt.jl index 55a55860d0..7b574e3874 100644 --- a/GALAHAD.jl/test/test_ssids.jl +++ b/GALAHAD.jl/test/test_slblt.jl @@ -1,5 +1,5 @@ -# test_ssids.jl -# Simple code to test the Julia interface to SSIDS +# test_slblt.jl +# Simple code to test the Julia interface to SLBLT using GALAHAD using Test @@ -7,16 +7,16 @@ using Printf using Accessors using Quadmath -function test_ssids(::Type{T}, ::Type{INT}) where {T,INT} +function test_slblt(::Type{T}, ::Type{INT}) where {T,INT} # Derived types - control = Ref{ssids_control_type{T,INT}}() - inform = Ref{ssids_inform_type{T,INT}}() + control = Ref{slblt_control_type{T,INT}}() + inform = Ref{slblt_inform_type{T,INT}}() # Initialize derived types akeep = Ref{Ptr{Cvoid}}(C_NULL) fkeep = Ref{Ptr{Cvoid}}(C_NULL) # Important that these are C_NULL to start with - ssids_default_control(T, INT, control) + slblt_default_control(T, INT, control) @reset control[].array_base = INT(1) # Fortran sparse matrix indexing @reset control[].nodend_control.print_level = INT(0) @@ -39,23 +39,23 @@ function test_ssids(::Type{T}, ::Type{INT}) where {T,INT} # perform analysis and factorization with data checking check = true - ssids_analyse(T, INT, check, n, C_NULL, ptr, row, C_NULL, akeep, control, inform) + slblt_analyse(T, INT, check, n, C_NULL, ptr, row, C_NULL, akeep, control, inform) if inform[].flag < 0 - ssids_free(T, INT, akeep, fkeep) - error("[SSIDS] The analysis failed!") + slblt_free(T, INT, akeep, fkeep) + error("[SLBLT] The analysis failed!") end - ssids_factor(T, INT, posdef, C_NULL, C_NULL, val, C_NULL, akeep[], fkeep, control, + slblt_factor(T, INT, posdef, C_NULL, C_NULL, val, C_NULL, akeep[], fkeep, control, inform) if inform[].flag < 0 - ssids_free(T, INT, akeep, fkeep) - error("[SSIDS] The factorization failed!") + slblt_free(T, INT, akeep, fkeep) + error("[SLBLT] The factorization failed!") end # solve - ssids_solve1(T, INT, INT(0), x, akeep[], fkeep[], control, inform) + slblt_solve1(T, INT, INT(0), x, akeep[], fkeep[], control, inform) if inform[].flag < 0 - ssids_free(T, INT, akeep, fkeep) - error("[SSIDS] The solve failed!") + slblt_free(T, INT, akeep, fkeep) + error("[SLBLT] The solve failed!") end @printf("The computed solution is:") @@ -66,7 +66,7 @@ function test_ssids(::Type{T}, ::Type{INT}) where {T,INT} # Determine and print the pivot order piv_order = zeros(INT, 5) - ssids_enquire_indef(T, INT, akeep[], fkeep[], control, inform, piv_order, C_NULL) + slblt_enquire_indef(T, INT, akeep[], fkeep[], control, inform, piv_order, C_NULL) @printf("Pivot order:") for i in 1:n @printf(" %3d", piv_order[i]) @@ -74,8 +74,8 @@ function test_ssids(::Type{T}, ::Type{INT}) where {T,INT} @printf("\n") # Delete internal workspace - flag = ssids_free(T, INT, akeep, fkeep) - (flag != 0) && error("[SSIDS] Error while calling ssids_free.") + flag = slblt_free(T, INT, akeep, fkeep) + (flag != 0) && error("[SLBLT] Error while calling slblt_free.") return 0 end @@ -87,8 +87,8 @@ for (T, INT, libgalahad) in ((Float32 , Int32, GALAHAD.libgalahad_single ), (Float128, Int32, GALAHAD.libgalahad_quadruple ), (Float128, Int64, GALAHAD.libgalahad_quadruple_64)) if isfile(libgalahad) - @testset "SSIDS -- $T -- $INT" begin - @test test_ssids(T, INT) == 0 + @testset "SLBLT -- $T -- $INT" begin + @test test_slblt(T, INT) == 0 end end end diff --git a/GALAHAD.jl/test/test_structures.jl b/GALAHAD.jl/test/test_structures.jl index 1a3fff7457..c0f06f4040 100644 --- a/GALAHAD.jl/test/test_structures.jl +++ b/GALAHAD.jl/test/test_structures.jl @@ -963,19 +963,19 @@ Ref{snls_inform_type{Float64,Int64}}()[] Ref{snls_inform_type{Float128,Int32}}()[] Ref{snls_inform_type{Float128,Int64}}()[] -# Structures for ssids -Ref{ssids_control_type{Float32,Int32}}()[] -Ref{ssids_control_type{Float32,Int64}}()[] -Ref{ssids_control_type{Float64,Int32}}()[] -Ref{ssids_control_type{Float64,Int64}}()[] -Ref{ssids_control_type{Float128,Int32}}()[] -Ref{ssids_control_type{Float128,Int64}}()[] -Ref{ssids_inform_type{Float32,Int32}}()[] -Ref{ssids_inform_type{Float32,Int64}}()[] -Ref{ssids_inform_type{Float64,Int32}}()[] -Ref{ssids_inform_type{Float64,Int64}}()[] -Ref{ssids_inform_type{Float128,Int32}}()[] -Ref{ssids_inform_type{Float128,Int64}}()[] +# Structures for slblt +Ref{slblt_control_type{Float32,Int32}}()[] +Ref{slblt_control_type{Float32,Int64}}()[] +Ref{slblt_control_type{Float64,Int32}}()[] +Ref{slblt_control_type{Float64,Int64}}()[] +Ref{slblt_control_type{Float128,Int32}}()[] +Ref{slblt_control_type{Float128,Int64}}()[] +Ref{slblt_inform_type{Float32,Int32}}()[] +Ref{slblt_inform_type{Float32,Int64}}()[] +Ref{slblt_inform_type{Float64,Int32}}()[] +Ref{slblt_inform_type{Float64,Int64}}()[] +Ref{slblt_inform_type{Float128,Int32}}()[] +Ref{slblt_inform_type{Float128,Int64}}()[] # Structures for ssls Ref{ssls_control_type{Float32,Int32}}()[] diff --git a/README.md b/README.md index fa3639a7c7..103c6e944c 100644 --- a/README.md +++ b/README.md @@ -60,7 +60,7 @@ By default GALAHAD will build with [OpenBLAS](https://github.com/OpenMathLib/Ope Please see [README.meson](https://github.com/ralna/GALAHAD/blob/master/README.meson) for instructions on how to tell Meson where to find these optional dependencies. #### Linear Solvers -By default GALAHAD will build the [SSIDS linear solver](https://github.com/ralna/spral), other alternative linear solvers are: +By default GALAHAD will use its `SLBLT` package, other alternative sparse linear solvers are: * [HSL](https://licences.stfc.ac.uk/products/Software/HSL/LibHSL) * [UMFPACK](https://people.engr.tamu.edu/davis/suitesparse.html) diff --git a/bin/build_one_shared b/bin/build_one_shared index 8e107b7454..dcd4300304 100755 --- a/bin/build_one_shared +++ b/bin/build_one_shared @@ -22,7 +22,7 @@ cd shared echo " unpacking static GALAHAD libraries in" echo " $PWD/shared" -for name in galahad_py galahad galahad_hsl galahad_spral \ +for name in galahad_py galahad galahad_hsl \ galahad_mkl_pardiso galahad_pardiso galahad_wsmp \ galahad_pastix galahad_mumps galahad_umfpack \ galahad_metis4 galahad_lapack galahad_blas \ diff --git a/bin/install_galahad_main b/bin/install_galahad_main index 9a9211994b..2a2d3dd293 100755 --- a/bin/install_galahad_main +++ b/bin/install_galahad_main @@ -795,10 +795,6 @@ echo '# -- PLplot --' >> $MAKEFILE echo ' ' >> $MAKEFILE echo 'PLPLOT = '$PLPLOT >> $MAKEFILE echo ' ' >> $MAKEFILE -echo '# proper or dummy SSIDS package?' >> $MAKEFILE -echo ' ' >> $MAKEFILE -echo 'SSIDS = '$SSIDS >> $MAKEFILE -echo ' ' >> $MAKEFILE echo '# Shell used' >> $MAKEFILE echo ' ' >> $MAKEFILE echo 'BINSHELL = '$BINSHELL >> $MAKEFILE diff --git a/bin/new_dgal b/bin/new_dgal index 6d38b1dd78..5697c3ed3c 100755 --- a/bin/new_dgal +++ b/bin/new_dgal @@ -236,19 +236,6 @@ HSL="" METIS4="" -# If there is a compiled, library version of the SPRAL sparse factorization -# package (http://ccpforge.cse.rl.ac.uk/gf/project/asearchralna/), set SPRAL -# to -lx, where the object library libx.so contains SPRAL. For instance if -# SPRAL is contained in the object library libspral.so, SPRAL should be -# set to "-lspral". If the library is in a "non-standard place", SPRAL -# should also point to the full path to the library. For example, if -# libspral.so is in the directory /mylibrary, SPRAL should be set to -# "-L/mylibrary -lspral" If a compiled version of SPRAL is unavailable, -# SPRAL should be set to "-lgalahad_spral". -# N.B. SPRAL is only optionally required but may improve performance. - -SPRAL="" - # If there is a compiled, library version of the PARDISO sparse factorization # package (http://www.pardiso-project.org/) , set PARDISO to -lx, # where the object library libx.so contains PARDISO. For instance if PARDISO @@ -346,7 +333,7 @@ eval "`cat $GALAHAD/bin/sys/$1`" GALOBJ=$GALAHAD/objects/$1/$PRECIS -# libraries for BLAS, LAPACK, HSL, METIS4, SPRAL, PARDISO, MKL_PARDISO WSMP, +# libraries for BLAS, LAPACK, HSL, METIS4, PARDISO, MKL_PARDISO WSMP, # PASTIX, MUMPS and UMFPACK if [[ "$BLAS" == "" ]]; then @@ -373,12 +360,6 @@ else METISLIB="$METIS4" fi -if [[ "$SPRAL" == "" ]]; then - SPRALLIB="-lgalahad_spral" -else - SPRALLIB="$SPRAL" -fi - if [[ "$PARDISO" == "" ]]; then PARDISOLIB="-lgalahad_pardiso" else @@ -600,7 +581,7 @@ fi #EXECUTABLE="$FORTRAN $FFLAGS -o $galmin $RUNMAIN \ # -L$GALOBJ -lgalahad $PROBLIB $CUTESTLIB -lgalahad \ -# $HSLLIB $SPRALLIB $PARDISOLIB $MKL_PARDISOLIB $WSMP \ +# $HSLLIB $PARDISOLIB $MKL_PARDISOLIB $WSMP \ # $PASTIXLIB $MUMPSLIB $UMFPACKLIB $SUITESPARSELIB \ # $METISLIB $LAPACKLIB $BLASLIB $PLPLOT" diff --git a/bin/setup.py b/bin/setup.py index a94bda7ca9..f82f0cfa1f 100644 --- a/bin/setup.py +++ b/bin/setup.py @@ -33,7 +33,7 @@ include_dirs=[np.get_include(),f'{GALAHAD}''/include/', \ f'{GALAHAD_OBJ}'] libraries=['galahad_py', 'galahad_c', 'galahad_hsl_c', 'galahad', \ - 'galahad_hsl', 'galahad_spral', 'stdc++', 'hwloc', \ + 'galahad_hsl', 'stdc++', 'hwloc', \ 'galahad_mkl_pardiso', 'galahad_pardiso', 'galahad_wsmp', \ 'galahad_pastix', 'galahad_mpi', 'galahad_mumps', \ 'galahad_umfpack', \ diff --git a/doc/C/rst-dir/sls_functions.rst b/doc/C/rst-dir/sls_functions.rst index d3c50f325a..cff01b8162 100644 --- a/doc/C/rst-dir/sls_functions.rst +++ b/doc/C/rst-dir/sls_functions.rst @@ -181,7 +181,7 @@ Select solver, set default control values and initialize private data * - solver - - is a one-dimensional array of type char that specifies the :ref:`solver package` that should be used to factorize the matrix $A$. It should be one of 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl pardiso', 'pastix', 'wsmp', 'potr', 'sytr' or 'pbtr'; lower or upper case variants are allowed. Only 'potr', 'sytr', 'pbtr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default, but others are easily installed (see README.external). + - is a one-dimensional array of type char that specifies the :ref:`solver package` that should be used to factorize the matrix $A$. It should be one of 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl pardiso', 'pastix', 'wsmp', 'potr', 'sytr' or 'pbtr'; lower or upper case variants are allowed. Only 'potr', 'sytr', 'pbtr' and 'slblt' are installed by default, but others are easily installed (see README.external). * - data diff --git a/doc/C/rst-dir/struct_bllsb_control_type.rst b/doc/C/rst-dir/struct_bllsb_control_type.rst index 4a70092b7f..ff1a283658 100644 --- a/doc/C/rst-dir/struct_bllsb_control_type.rst +++ b/doc/C/rst-dir/struct_bllsb_control_type.rst @@ -667,7 +667,7 @@ if .generate_qplib_file is true, a QPLIB file describing the current problem is char symmetric_linear_solver[31] -the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; sif_file_name .. _doxid-structbllsb__control__type_sif_file_name: diff --git a/doc/C/rst-dir/struct_clls_control_type.rst b/doc/C/rst-dir/struct_clls_control_type.rst index 6a665f9eba..47c4456e8e 100644 --- a/doc/C/rst-dir/struct_clls_control_type.rst +++ b/doc/C/rst-dir/struct_clls_control_type.rst @@ -667,7 +667,7 @@ if .generate_qplib_file is true, a QPLIB file describing the current problem is char symmetric_linear_solver[31] -the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; sif_file_name .. _doxid-structclls__control__type_sif_file_name: diff --git a/doc/C/rst-dir/struct_cro_control_type.rst b/doc/C/rst-dir/struct_cro_control_type.rst index 2dd013baf6..0bc1bf9e46 100644 --- a/doc/C/rst-dir/struct_cro_control_type.rst +++ b/doc/C/rst-dir/struct_cro_control_type.rst @@ -163,7 +163,7 @@ if .deallocate_error_fatal is true, any array/pointer deallocation error will te char symmetric_linear_solver[31] -the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; unsymmetric_linear_solver .. _doxid-structcro__control__type_unsymmetric_linear_solver: diff --git a/doc/C/rst-dir/struct_dps_control_type.rst b/doc/C/rst-dir/struct_dps_control_type.rst index d175509926..307af7a690 100644 --- a/doc/C/rst-dir/struct_dps_control_type.rst +++ b/doc/C/rst-dir/struct_dps_control_type.rst @@ -219,7 +219,7 @@ name of file into which to write problem data char symmetric_linear_solver[31] -the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; prefix .. _doxid-structdps__control__type_prefix: diff --git a/doc/C/rst-dir/struct_dqp_control_type.rst b/doc/C/rst-dir/struct_dqp_control_type.rst index 6be49b2abb..1dfb3cbe53 100644 --- a/doc/C/rst-dir/struct_dqp_control_type.rst +++ b/doc/C/rst-dir/struct_dqp_control_type.rst @@ -575,7 +575,7 @@ if .generate_qplib_file is .true. if a QPLIB file describing the current problem char symmetric_linear_solver[31] -the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; definite_linear_solver .. _doxid-structdqp__control__type_definite_linear_solver: @@ -585,7 +585,7 @@ the name of the symmetric-indefinite linear equation solver used. Possible choic char definite_linear_solver[31] -the name of the definite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', 'potr', 'sytr' and 'pbtr', although only 'potr', 'sytr', 'pbtr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the definite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', 'potr', 'sytr' and 'pbtr', although only 'potr', 'sytr', 'pbtr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; unsymmetric_linear_solver .. _doxid-structdqp__control__type_unsymmetric_linear_solver: diff --git a/doc/C/rst-dir/struct_fdc_control_type.rst b/doc/C/rst-dir/struct_fdc_control_type.rst index c45cb4efaf..79ccd4ec5c 100644 --- a/doc/C/rst-dir/struct_fdc_control_type.rst +++ b/doc/C/rst-dir/struct_fdc_control_type.rst @@ -182,7 +182,7 @@ exit if any deallocation fails char symmetric_linear_solver[31] -the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; unsymmetric_linear_solver .. _doxid-structfdc__control__type_unsymmetric_linear_solver: diff --git a/doc/C/rst-dir/struct_llsr_control_type.rst b/doc/C/rst-dir/struct_llsr_control_type.rst index 89593997a8..30080f05e8 100644 --- a/doc/C/rst-dir/struct_llsr_control_type.rst +++ b/doc/C/rst-dir/struct_llsr_control_type.rst @@ -216,7 +216,7 @@ exit if any deallocation fails char definite_linear_solver[31] -the name of the definite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', 'potr', 'sytr' and 'pbtr', although only 'potr', 'sytr', 'pbtr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the definite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', 'potr', 'sytr' and 'pbtr', although only 'potr', 'sytr', 'pbtr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; prefix .. _doxid-structllsr__control__type_prefix: diff --git a/doc/C/rst-dir/struct_llst_control_type.rst b/doc/C/rst-dir/struct_llst_control_type.rst index 9c537c4f0f..d28da6fdd6 100644 --- a/doc/C/rst-dir/struct_llst_control_type.rst +++ b/doc/C/rst-dir/struct_llst_control_type.rst @@ -227,7 +227,7 @@ exit if any deallocation fails char definite_linear_solver[31] -the name of the definite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', 'potr', 'sytr' and 'pbtr', although only 'potr', 'sytr', 'pbtr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the definite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', 'potr', 'sytr' and 'pbtr', although only 'potr', 'sytr', 'pbtr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; prefix diff --git a/doc/C/rst-dir/struct_nrek_control_type.rst b/doc/C/rst-dir/struct_nrek_control_type.rst index bcec52f57b..cd6e956199 100644 --- a/doc/C/rst-dir/struct_nrek_control_type.rst +++ b/doc/C/rst-dir/struct_nrek_control_type.rst @@ -227,7 +227,7 @@ exit if any deallocation fails char linear_solver[31] -the name of the linear equation solver used to solve any symmetric positive-definite linear system involving $H$ that might arise. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', ssids, 'pardiso', 'wsmp', 'sytr', 'potr' and 'pbtr' although only 'sytr', 'potr', 'pbtr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the linear equation solver used to solve any symmetric positive-definite linear system involving $H$ that might arise. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', slblt, 'pardiso', 'wsmp', 'sytr', 'potr' and 'pbtr' although only 'sytr', 'potr', 'pbtr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; definite_linear_solver_for_s .. _doxid-structnrek__control__type_linear_solver_for_s: @@ -237,7 +237,7 @@ the name of the linear equation solver used to solve any symmetric positive-defi char linear_solver_for_s[31] -the name of the linear equation solver used to solve any symmetric positive-definite linear system involving the optional $S$ that might arise. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', ssids, 'pardiso', 'wsmp', 'sytr', 'potr' and 'pbtr' although only 'sytr', 'potr', 'pbtr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the linear equation solver used to solve any symmetric positive-definite linear system involving the optional $S$ that might arise. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', slblt, 'pardiso', 'wsmp', 'sytr', 'potr' and 'pbtr' although only 'sytr', 'potr', 'pbtr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; prefix .. _doxid-structnrek__control__type_prefix: diff --git a/doc/C/rst-dir/struct_psls_control_type.rst b/doc/C/rst-dir/struct_psls_control_type.rst index 19a3ef19a4..5c63c6dc8c 100644 --- a/doc/C/rst-dir/struct_psls_control_type.rst +++ b/doc/C/rst-dir/struct_psls_control_type.rst @@ -261,7 +261,7 @@ exit if any deallocation fails char symmetric_linear_solver[31] -the name of the symmetric linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp' and 'sytr, although only 'sytr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the symmetric linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp' and 'sytr, although only 'sytr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; definite_linear_solver .. _doxid-structpsls__control__type_definite_linear_solver: @@ -271,7 +271,7 @@ the name of the symmetric linear equation solver used. Possible choices are curr char definite_linear_solver[31] -the name of the definite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', 'potr', 'sytr' and 'pbtr', although only 'potr', 'sytr', 'pbtr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the definite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', 'potr', 'sytr' and 'pbtr', although only 'potr', 'sytr', 'pbtr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; prefix .. _doxid-structpsls__control__type_prefix: diff --git a/doc/C/rst-dir/struct_qpa_control_type.rst b/doc/C/rst-dir/struct_qpa_control_type.rst index 5987ac09dc..ad936fd462 100644 --- a/doc/C/rst-dir/struct_qpa_control_type.rst +++ b/doc/C/rst-dir/struct_qpa_control_type.rst @@ -550,7 +550,7 @@ if .generate_sif_file is .true. if a SIF file describing the current problem is char symmetric_linear_solver[31] -the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; sif_file_name .. _doxid-structqpa__control__type_sif_file_name: diff --git a/doc/C/rst-dir/struct_rqs_control_type.rst b/doc/C/rst-dir/struct_rqs_control_type.rst index 72d4afc653..64245788c6 100644 --- a/doc/C/rst-dir/struct_rqs_control_type.rst +++ b/doc/C/rst-dir/struct_rqs_control_type.rst @@ -321,7 +321,7 @@ name of file into which to write problem data char symmetric_linear_solver[31] -the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; definite_linear_solver .. _doxid-structrqs__control__type_definite_linear_solver: @@ -331,7 +331,7 @@ the name of the symmetric-indefinite linear equation solver used. Possible choic char definite_linear_solver[31] -the name of the definite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', 'potr', 'sytr' and 'pbtr', although only 'potr', 'sytr', 'pbtr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the definite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', 'potr', 'sytr' and 'pbtr', although only 'potr', 'sytr', 'pbtr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; prefix .. _doxid-structrqs__control__type_prefix: diff --git a/doc/C/rst-dir/struct_sbls_control_type.rst b/doc/C/rst-dir/struct_sbls_control_type.rst index 480ffa85cb..146828af0a 100644 --- a/doc/C/rst-dir/struct_sbls_control_type.rst +++ b/doc/C/rst-dir/struct_sbls_control_type.rst @@ -457,7 +457,7 @@ exit if any deallocation fails char symmetric_linear_solver[31] -the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; definite_linear_solver .. _doxid-structsbls__control__type_definite_linear_solver: @@ -467,7 +467,7 @@ the name of the symmetric-indefinite linear equation solver used. Possible choic char definite_linear_solver[31] -the name of the definite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', 'potr', 'sytr' and 'pbtr', although only 'potr', 'sytr', 'pbtr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the definite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', 'potr', 'sytr' and 'pbtr', although only 'potr', 'sytr', 'pbtr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; unsymmetric_linear_solver .. _doxid-structsbls__control__type_unsymmetric_linear_solver: diff --git a/doc/C/rst-dir/struct_sllsb_control_type.rst b/doc/C/rst-dir/struct_sllsb_control_type.rst index 51e0603e63..0b75f187d1 100644 --- a/doc/C/rst-dir/struct_sllsb_control_type.rst +++ b/doc/C/rst-dir/struct_sllsb_control_type.rst @@ -667,7 +667,7 @@ if .generate_qplib_file is true, a QPLIB file describing the current problem is char symmetric_linear_solver[31] -the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; sif_file_name .. _doxid-structsllsb__control__type_sif_file_name: diff --git a/doc/C/rst-dir/struct_sls_inform_type.rst b/doc/C/rst-dir/struct_sls_inform_type.rst index 42b74c4865..680e1c5d90 100644 --- a/doc/C/rst-dir/struct_sls_inform_type.rst +++ b/doc/C/rst-dir/struct_sls_inform_type.rst @@ -71,7 +71,7 @@ sls_inform_type structure struct ma86_info :ref:`ma86_info`; struct ma87_info :ref:`ma87_info`; struct ma97_info :ref:`ma97_info`; - struct ssids_inform :ref:`ssids_inform`; + struct slblt_inform :ref:`slblt_inform`; struct nodend_inform :ref:`nodend_inform`; :ref:`ipc_` :ref:`mc61_info`[10]; :ref:`rpc_` :ref:`mc61_rinfo`[15]; @@ -664,15 +664,15 @@ the output structure from ma87 the output structure from ma97 -.. index:: pair: variable; ssids_inform -.. _doxid-structsls__inform__type_ssids_inform: +.. index:: pair: variable; slblt_inform +.. _doxid-structsls__inform__type_slblt_inform: .. ref-code-block:: cpp :class: doxyrest-title-code-block - struct spral_ssids_inform_type ssids_inform + struct slblt_inform_type slblt_inform -the output structure from ssids +the output structure from slblt .. index:: pair: variable; nodend_inform .. _doxid-structsls__inform__type_nodend_inform: diff --git a/doc/C/rst-dir/struct_ssls_control_type.rst b/doc/C/rst-dir/struct_ssls_control_type.rst index eb7fe833a6..cb71e668c0 100644 --- a/doc/C/rst-dir/struct_ssls_control_type.rst +++ b/doc/C/rst-dir/struct_ssls_control_type.rst @@ -103,7 +103,7 @@ exit if any deallocation fails char symmetric_linear_solver[31] -the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; prefix .. _doxid-structssls__control__type_prefix: diff --git a/doc/C/rst-dir/struct_trek_control_type.rst b/doc/C/rst-dir/struct_trek_control_type.rst index 9bbd65831b..9f410e9f1a 100644 --- a/doc/C/rst-dir/struct_trek_control_type.rst +++ b/doc/C/rst-dir/struct_trek_control_type.rst @@ -227,7 +227,7 @@ exit if any deallocation fails char linear_solver[31] -the name of the linear equation solver used to solve any symmetric positive-definite linear system involving $H$ that might arise. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', ssids, 'pardiso', 'wsmp', 'sytr', 'potr' and 'pbtr' although only 'sytr', 'potr', 'pbtr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the linear equation solver used to solve any symmetric positive-definite linear system involving $H$ that might arise. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', slblt, 'pardiso', 'wsmp', 'sytr', 'potr' and 'pbtr' although only 'sytr', 'potr', 'pbtr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; definite_linear_solver_for_s .. _doxid-structtrek__control__type_linear_solver_for_s: @@ -237,7 +237,7 @@ the name of the linear equation solver used to solve any symmetric positive-defi char linear_solver_for_s[31] -the name of the linear equation solver used to solve any symmetric positive-definite linear system involving the optional $S$ that might arise. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', ssids, 'pardiso', 'wsmp', 'sytr', 'potr' and 'pbtr' although only 'sytr', 'potr', 'pbtr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the linear equation solver used to solve any symmetric positive-definite linear system involving the optional $S$ that might arise. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', slblt, 'pardiso', 'wsmp', 'sytr', 'potr' and 'pbtr' although only 'sytr', 'potr', 'pbtr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; prefix .. _doxid-structtrek__control__type_prefix: diff --git a/doc/C/rst-dir/struct_trs_control_type.rst b/doc/C/rst-dir/struct_trs_control_type.rst index 1f8380c336..339b930823 100644 --- a/doc/C/rst-dir/struct_trs_control_type.rst +++ b/doc/C/rst-dir/struct_trs_control_type.rst @@ -360,7 +360,7 @@ name of file into which to write problem data char symmetric_linear_solver[31] -the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the symmetric-indefinite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', and 'sytr', although only 'sytr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; definite_linear_solver .. _doxid-structtrs__control__type_definite_linear_solver: @@ -370,7 +370,7 @@ the name of the symmetric-indefinite linear equation solver used. Possible choic char definite_linear_solver[31] -the name of the definite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', 'potr', 'sytr' and 'pbtr', although only 'potr', 'sytr', 'pbtr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the definite linear equation solver used. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl_pardiso', 'pastix', 'wsmp', 'potr', 'sytr' and 'pbtr', although only 'potr', 'sytr', 'pbtr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; prefix .. _doxid-structtrs__control__type_prefix: diff --git a/doc/Julia/rst-dir/sls_functions.rst b/doc/Julia/rst-dir/sls_functions.rst index 0bfb7ef5cf..e3cd6c727d 100644 --- a/doc/Julia/rst-dir/sls_functions.rst +++ b/doc/Julia/rst-dir/sls_functions.rst @@ -19,7 +19,7 @@ Select solver, set default control values and initialize private data * - solver - - is a one-dimensional array of type Vararg{Cchar} that specifies the :ref:`solver package` that should be used to factorize the matrix $A$. It should be one of 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl pardiso', 'pastix', 'wsmp', 'potr', 'sytr' or 'pbtr'; lower or upper case variants are allowed. + - is a one-dimensional array of type Vararg{Cchar} that specifies the :ref:`solver package` that should be used to factorize the matrix $A$. It should be one of 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl pardiso', 'pastix', 'wsmp', 'potr', 'sytr' or 'pbtr'; lower or upper case variants are allowed. * - data diff --git a/doc/Julia/rst-dir/struct_nrek_control_type.rst b/doc/Julia/rst-dir/struct_nrek_control_type.rst index cd03699b2d..7e21b24d4d 100644 --- a/doc/Julia/rst-dir/struct_nrek_control_type.rst +++ b/doc/Julia/rst-dir/struct_nrek_control_type.rst @@ -224,7 +224,7 @@ exit if any deallocation fails char linear_solver[31] -the name of the linear equation solver used to solve any symmetric positive-definite linear system involving $H$ that might arise. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', ssids, 'pardiso', 'wsmp', 'sytr', 'potr' and 'pbtr' although only 'sytr', 'potr', 'pbtr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the linear equation solver used to solve any symmetric positive-definite linear system involving $H$ that might arise. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', slblt, 'pardiso', 'wsmp', 'sytr', 'potr' and 'pbtr' although only 'sytr', 'potr', 'pbtr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; linear_solver_for_s .. _doxid-structnrek__control__type_linear_solver_for_s: @@ -234,7 +234,7 @@ the name of the linear equation solver used to solve any symmetric positive-defi char linear_solver_for_s[31] -the name of the linear equation solver used to solve any symmetric positive-definite linear system involving the optional $S$ that might arise. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', ssids, 'pardiso', 'wsmp', 'sytr', 'potr' and 'pbtr' although only 'sytr', 'potr', 'pbtr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the linear equation solver used to solve any symmetric positive-definite linear system involving the optional $S$ that might arise. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', slblt, 'pardiso', 'wsmp', 'sytr', 'potr' and 'pbtr' although only 'sytr', 'potr', 'pbtr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; prefix .. _doxid-structnrek__control__type_prefix: diff --git a/doc/Julia/rst-dir/struct_psls_control_type.rst b/doc/Julia/rst-dir/struct_psls_control_type.rst index 1ec09707ae..ac6bfb5b9d 100644 --- a/doc/Julia/rst-dir/struct_psls_control_type.rst +++ b/doc/Julia/rst-dir/struct_psls_control_type.rst @@ -257,7 +257,7 @@ exit if any deallocation fails NTuple{31,Cchar} symmetric_linear_solver -the symmetric linear equation :ref:`solver package` used when .preconditioner = 5. Possible choices are currently: sils, ma27, ma57, ma77, ma86, ma97, ssids, mumps, pardiso, mkl_pardiso,pastix, wsmp, sytr, potr and pbtr, although only sils, sytr and, for OMP 4.0-compliant compilers, ssids are installed by default. +the symmetric linear equation :ref:`solver package` used when .preconditioner = 5. Possible choices are currently: sils, ma27, ma57, ma77, ma86, ma97, slblt, mumps, pardiso, mkl_pardiso,pastix, wsmp, sytr, potr and pbtr, although only sils, sytr and slblt are installed by default. .. index:: pair: variable; definite_linear_solver .. _doxid-structpsls__control__type_definite_linear_solver: @@ -267,7 +267,7 @@ the symmetric linear equation :ref:`solver package` used w NTuple{31,Cchar} definite_linear_solver -the definite linear equation :ref:`solver package` used when .preconditioner = 4. Possible choices are currently: sils, ma27, ma57, ma77, ma86, ma87, ma97, ssids, mumps, pardiso, mkl_pardiso,pastix, wsmp, sytr, potr and pbtr, although only sils, sytr, potr, pbtr and, for OMP 4.0-compliant compilers, ssids are installed by default. +the definite linear equation :ref:`solver package` used when .preconditioner = 4. Possible choices are currently: sils, ma27, ma57, ma77, ma86, ma87, ma97, slblt, mumps, pardiso, mkl_pardiso,pastix, wsmp, sytr, potr and pbtr, although only sils, sytr, potr, pbtr and slblt are installed by default. .. index:: pair: variable; prefix .. _doxid-structpsls__control__type_prefix: diff --git a/doc/Julia/rst-dir/struct_ssids_types.rst b/doc/Julia/rst-dir/struct_slblt_types.rst similarity index 73% rename from doc/Julia/rst-dir/struct_ssids_types.rst rename to doc/Julia/rst-dir/struct_slblt_types.rst index 4e722596a3..a20db57e53 100644 --- a/doc/Julia/rst-dir/struct_ssids_types.rst +++ b/doc/Julia/rst-dir/struct_slblt_types.rst @@ -1,10 +1,10 @@ -.. index:: pair: struct; ssids_control -.. index:: pair: struct; ssids_inform -.. _doxid-structssids__controlinform: +.. index:: pair: struct; slblt_control +.. index:: pair: struct; slblt_inform +.. _doxid-structslblt__controlinform: -.. _details-structspral__ssids__options: +.. _details-structslblt__options: -spral_ssids_options structure +slblt_options structure ----------------------------- .. toctree:: @@ -13,7 +13,7 @@ spral_ssids_options structure .. ref-code-block:: julia :class: doxyrest-overview-code-block - struct spral_ssids_options{T,INT} + struct slblt_options{T,INT} array_base::INT print_level::INT unit_diagnostics::INT @@ -29,7 +29,7 @@ spral_ssids_options structure gpu_perf_coeff::Cfloat scaling::INT small_subtree_threshold::Int64 - cpu_block_size::INT + block_size::INT action::Bool pivot_method::INT small::T @@ -39,9 +39,9 @@ spral_ssids_options structure min_loadbalance::Cfloat failed_pivot_method::INT -.. _details-structspral__ssids__inform: +.. _details-structslblt__inform: -spral_ssids_inform structure +slblt_inform structure ----------------------------- .. toctree:: @@ -50,7 +50,7 @@ spral_ssids_inform structure .. ref-code-block:: julia :class: doxyrest-overview-code-block - struct spral_ssids_inform{INT} + struct slblt_inform{INT} flag::INT matrix_dup::INT matrix_missing_diag::INT @@ -77,6 +77,4 @@ spral_ssids_inform structure detailed documentation ---------------------- -SSIDS package option and info derived types as Julia structures. -See `SPRAL-SSIDS `_ -documentation for further details. +SLBLT package option and info derived types as Julia structures. diff --git a/doc/Julia/rst-dir/struct_sls_inform_type.rst b/doc/Julia/rst-dir/struct_sls_inform_type.rst index 8693dbe3d3..54c4d92781 100644 --- a/doc/Julia/rst-dir/struct_sls_inform_type.rst +++ b/doc/Julia/rst-dir/struct_sls_inform_type.rst @@ -8,7 +8,7 @@ sls_inform_type structure :hidden: struct_hsl_types.rst - struct_ssids_types.rst + struct_slblt_types.rst .. ref-code-block:: julia :class: doxyrest-overview-code-block @@ -70,7 +70,7 @@ sls_inform_type structure ma86_info::ma86_info{T,INT} ma87_info::ma87_info{T,INT} ma97_info::ma97_info{T,INT} - ssids_inform::ssids_inform_type{INT} + slblt_inform::slblt_inform_type{INT} nodend_inform::nodend_inform_type{INT} mc61_info::NTuple{10,INT} mc61_rinfo::NTuple{15,T} @@ -724,15 +724,15 @@ the output structure from hsl_ma87 the output structure from hsl_ma97 -.. index:: pair: variable; ssids_inform -.. _doxid-structsls__inform__type_ssids_inform: +.. index:: pair: variable; slblt_inform +.. _doxid-structsls__inform__type_slblt_inform: .. ref-code-block:: julia :class: doxyrest-title-code-block - struct :ref:`ssids_inform_type` ssids_inform + struct :ref:`slblt_inform_type` slblt_inform -the output structure from ssids +the output structure from slblt .. index:: pair: variable; nodend_inform .. _doxid-structsls__inform__type_nodend_inform: diff --git a/doc/Julia/rst-dir/struct_trek_control_type.rst b/doc/Julia/rst-dir/struct_trek_control_type.rst index b2bde0ba4a..d903eed521 100644 --- a/doc/Julia/rst-dir/struct_trek_control_type.rst +++ b/doc/Julia/rst-dir/struct_trek_control_type.rst @@ -224,7 +224,7 @@ exit if any deallocation fails char linear_solver[31] -the name of the linear equation solver used to solve any symmetric positive-definite linear system involving $H$ that might arise. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', ssids, 'pardiso', 'wsmp', 'sytr', 'potr' and 'pbtr' although only 'sytr', 'potr', 'pbtr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the linear equation solver used to solve any symmetric positive-definite linear system involving $H$ that might arise. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', slblt, 'pardiso', 'wsmp', 'sytr', 'potr' and 'pbtr' although only 'sytr', 'potr', 'pbtr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; linear_solver_for_s .. _doxid-structtrek__control__type_linear_solver_for_s: @@ -234,7 +234,7 @@ the name of the linear equation solver used to solve any symmetric positive-defi char linear_solver_for_s[31] -the name of the linear equation solver used to solve any symmetric positive-definite linear system involving the optional $S$ that might arise. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', ssids, 'pardiso', 'wsmp', 'sytr', 'potr' and 'pbtr' although only 'sytr', 'potr', 'pbtr' and, for OMP 4.0-compliant compilers, 'ssids' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. +the name of the linear equation solver used to solve any symmetric positive-definite linear system involving the optional $S$ that might arise. Possible choices are currently: 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', slblt, 'pardiso', 'wsmp', 'sytr', 'potr' and 'pbtr' although only 'sytr', 'potr', 'pbtr' and 'slblt' are installed by default; others are easily installed (see README.external). More details of the capabilities of each solver are provided in the documentation for :ref:`galahad_sls`. .. index:: pair: variable; prefix .. _doxid-structtrek__control__type_prefix: diff --git a/doc/Python/psls.rst b/doc/Python/psls.rst index b68b5b9018..2fc0a35d4f 100644 --- a/doc/Python/psls.rst +++ b/doc/Python/psls.rst @@ -163,16 +163,16 @@ functions symmetric_linear_solver : str the symmetric linear equation solver used when ``preconditioner`` = 5. Possible choices are currently: - sils, ma27, ma57, ma77, ma86, ma97, ssids, mumps, pardiso, + sils, ma27, ma57, ma77, ma86, ma97, slblt, mumps, pardiso, mkl_pardiso, pastix, wsmp and sytrr, although only sils, - sytr and, for OMP 4.0-compliant compilers, ssids are + sytr and slblt are installed by default. definite_linear_solver : str the definite linear equation solver used when ``preconditioner`` = 4. Possible choices are currently: - sils, ma27, ma57, ma77, ma86, ma87, ma97, ssids, mumps, pardiso, + sils, ma27, ma57, ma77, ma86, ma87, ma97, slblt, mumps, pardiso, mkl_pardiso, pastix, wsmp, sytr, potr and pbtr, although only sils, - sytr, potr, pbtr and, for OMP 4.0-compliant compilers, ssids are + sytr, potr, pbtr and slblt are installed by default. prefix : str all output lines will be prefixed by the string contained diff --git a/doc/Python/psls_intro.rst b/doc/Python/psls_intro.rst index dfbdd37d97..85fb245530 100644 --- a/doc/Python/psls_intro.rst +++ b/doc/Python/psls_intro.rst @@ -76,11 +76,11 @@ are given in the following table. - yes - no - OpenMP core - * - ``SSIDS`` + * - ``SLBLT`` - multifrontal - yes - no - - CUDA core + - OpenMP core * - ``MUMPS`` - multifrontal - yes @@ -122,7 +122,7 @@ are given in the following table. - no - with parallel LAPACK -Note that, with the exception of ``SSIDS`` and the Netlib +Note that, with the exception of ``SLBLT`` and the Netlib reference LAPACK codes, **the solvers themselves do not form part of this package and must be obtained/linked to separately.** See the documentation for ``sls`` diff --git a/doc/Python/sls.rst b/doc/Python/sls.rst index 82ac537dca..65c73a5821 100644 --- a/doc/Python/sls.rst +++ b/doc/Python/sls.rst @@ -19,7 +19,7 @@ functions solver : str the name of the solver required to solve $Ax=b$. It should be one of 'sils', 'ma27', 'ma57', 'ma77', 'ma86', - 'ma87', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl pardiso', + 'ma87', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl pardiso', 'pastix', 'wsmp', 'potr', 'sytr' or 'pbtr'; lower or upper case variants are allowed. @@ -571,8 +571,8 @@ functions the output structure from ma87. ma97_info : dict the output structure from ma97. - ssids_inform : dict - the output structure from ssids. + slblt_inform : dict + the output structure from slblt. nodend_inform : dict the output structure from nodend. mc61_info : int diff --git a/doc/Python/sls_intro.rst b/doc/Python/sls_intro.rst index 2468addae1..f34224e651 100644 --- a/doc/Python/sls_intro.rst +++ b/doc/Python/sls_intro.rst @@ -13,13 +13,13 @@ The method provides a common interface to a variety of well-known solvers from HSL and elsewhere. Currently supported solvers include ``MA27/SILS``, ``HSL_MA57``, ``HSL_MA77`` , ``HSL_MA86``, ``HSL_MA87`` and ``HSL_MA97`` from {HSL}, -``SSIDS`` from {SPRAL}, +``SLBLT`` from {GALAHAD}, ``MUMPS`` from Mumps Technologies, ``PARDISO`` both from the Pardiso Project and Intel's MKL, ``PaStiX`` from Inria, and ``WSMP`` from the IBM alpha Works, as well as ``POTR``, ``SYTR`` and ``SBTR`` from LAPACK. -Note that, with the exception of ``SSIDS`` and the Netlib +Note that, with the exception of ``SLBLT`` and the Netlib reference LAPACK codes, **the solvers themselves do not form part of this package and must be obtained/linked to separately.** @@ -88,11 +88,11 @@ given in the following table: - yes - no - OpenMP core - * - ``SSIDS`` + * - ``SLBLT`` - multifrontal - yes - no - - CUDA core + - OpenMP core * - ``MUMPS`` - multifrontal - yes @@ -160,9 +160,6 @@ To obtain HSL 2011 packages, see - http://hsl.rl.ac.uk . -The solver ``SSIDS`` is from the SPRAL sparse-matrix collection, -and is available as part of GALAHAD. - The solver ``MUMPS`` is available from Mumps Technologies in France, and version 5.5.1 or above is sufficient. To obtain ``MUMPS``, see diff --git a/doc/README b/doc/README index 173333544b..b04fbc46ab 100644 --- a/doc/README +++ b/doc/README @@ -115,7 +115,7 @@ In order to get GALAHAD working **using make**, here is what you need to do. see 8 below.) Without these codes, your choice of key linear equation solvers is - severly restricted. In particular, if the default solver, ssids, is + severly restricted. In particular, if the default solver, slblt, is not supported by yur compiler, you will be forced to use LAPACk routines, and these may limit the size of problems that can be solved. @@ -216,84 +216,27 @@ In order to get GALAHAD working **using make**, here is what you need to do. and that $GALAHAD/src/matlab is on your Matlab path. See README.matlab for more details. -11 If you are running on a Linux/OSX system, you may need to install the - Open-MPI Portable Hardware Locality (HWLOC) development package +11 GALAHAD's parallel sparse solver SLBLT detects the machine's NUMA + topology automatically (on Linux, by reading /sys); no external + hardware-locality library needs to be installed. - https://www.open-mpi.org/projects/hwloc/ + For best parallel performance, set the environment variables OMP_NESTED + and OMP_PROC_BIND to TRUE, and OMP_MAX_ACTIVE_LEVELS to the maximum + number of nested parallel levels you wish to use. Under the sh/bash + shell, put - This is readily available in many Linux distributions, e.g., via - - sudo apt-get install libhwloc-dev - - on Debian/Ubuntu systems, - - sudo rpm --install libhwloc-dev - - for Redhat ones, or - - brew install hwloc - - for Macs under OSX. - - You will also need to set environment variables OMP_CANCELLATION, - OMP_NESTED and OMP_PROC_BIND to TRUE, and OMP_MAX_ACTIVE_LEVEL to - the maximum number of parallel threads you wish to use. - Under the sh/bash shell, put - - export OMP_CANCELLATION=true export OMP_NESTED=true export OMP_PROC_BIND=true export OMP_MAX_ACTIVE_LEVELS=8 in your startup script, to use a maximum of 8 threads, and for csh/tcsh - setenv OMP_CANCELLATION true setenv OMP_NESTED true setenv OMP_PROC_BIND true setenv OMP_MAX_ACTIVE_LEVELS 8 Check with your system administrator if you need help! - If it *really* is impossible to install libhwloc-dev, you should edit - the file $GALAHAD/include/ssids_config.h and replace the line - - #define HAVE_HWLOC 1 - - with - - #undef HAVE_HWLOC - - Alternatively, during the GALAHAD install (13 below), when you get to - the prompt - - Would you like to review and modify the C compiler settings (y/N)? - - answer y, and change the variable HWLOC to read - - HWLOC='un' - - Currently this is done automatically for ifort/icc and - gfortran/gcc to avoid compiler bugs - - Finally, if you do have HWLOC, you can improve the performannce of - codes that rely on it, by setting an appropriate xml file that gives - your specific hardware locality. To do so, use hwloc's lstopo to - generate the xml file, and then set an appropriate environment variable - to point at this file. For example, under Linux or OSX, if you have a - local ~/.config directory, then - - lstopo --of xml ~/.config/hwloc-topology.xml - - generates the file, and - - export HWLOC_XMLFILE=$HOME/.config/hwloc-topology.xml - - (for sh/bash) or - - setenv HWLOC_XMLFILE $HOME/.config/hwloc-topology.xml - - (for csh/tcsh) is appropriate - 12. For Windows systems that use MSYS/MINGW, you will also need to set the environment variable MSYS2 to point to the folder that contains the Unix-style shell and commands, and MINGW64 to the folder that holds diff --git a/doc/README.C b/doc/README.C index 71b54813a8..4bed7f066e 100644 --- a/doc/README.C +++ b/doc/README.C @@ -120,7 +120,7 @@ this should provide a template for users' actual problems. To link with other applications, you should use - -lgalahad_c -lgalahad_hsl_c -lgalahad -lgalahad_hsl -lgalahad_spral \ + -lgalahad_c -lgalahad_hsl_c -lgalahad -lgalahad_hsl \ -lgalahad_mkl_pardiso -lgalahad_pardiso -lgalahad_wsmp \ -lgalahad_pastix -lgalahad_mumps -lgalahad_mpi -galahad_umfpack \ -lgalahad_metis_dummy -lgalahad_lapack -lgalahad_blas diff --git a/doc/README.external b/doc/README.external index 9158e2635b..418e861372 100644 --- a/doc/README.external +++ b/doc/README.external @@ -24,7 +24,6 @@ and by default are set as BLAS = -lgalahad_blas LAPACK = -lgalahad_lapack HSL = -lgalahad_hsl -SPRAL = -lgalahad_spral METIS = -lgalahad_metis_dummy PARDISO = -lgalahad_pardiso MKL_PARDISO = -lgalahad_mkl_pardiso @@ -46,7 +45,6 @@ by default are BLAS="-lgalahad_blas" LAPACK="-lgalahad_lapack" HSL="-lgalahad_hsl" -SPRAL="-lgalahad_spral" METIS="-lgalahad_metis_dummy" PARDISO="-lgalahad_pardiso" MKL_PARDISO="-lgalahad_mkl_pardiso" diff --git a/doc/README.meson b/doc/README.meson index ac1834111e..61f19adcf8 100644 --- a/doc/README.meson +++ b/doc/README.meson @@ -99,7 +99,6 @@ Currently supported options with their default value: * `-Dsingle=true`: generate the single precision library, tests and examples; * `-Ddouble=true`: generate the double precision library, tests and examples; * `-Dquadruple=false`: generate the quadruple precision library, tests and examples; -* `-Dssids=true`: build ssids; * `-Dlibblas=openblas`: BLAS library against which to link; * `-Dliblapack=openblas`: LAPACK library against which to link; * `-Dlibhsl=hsl_subset`: HSL library against which to link; @@ -113,7 +112,6 @@ Currently supported options with their default value: * `-Dlibsmumps=smumps`: Single-precision MUMPS library against which to link; * `-Dlibdmumps=dmumps`: Double-precision MUMPS library against which to link; * `-Dlibasl=asl`: AMPL solver library against which to link; -* `-Dlibhwloc=hwloc`: HWLOC library against which to link; * `-Dlibblas_path=[]`: additional directories to search for the BLAS library; * `-Dliblapack_path=[]`: additional directories to search for the LAPACK library; * `-Dlibhsl_path=[]`: additional directories to search for the HSL library; @@ -125,19 +123,17 @@ Currently supported options with their default value: * `-Dlibmumps_path=[]`: additional directories to search for the MUMPS libraries; * `-Dlibasl_path=[]`: additional directories to search for the AMPL solver library; * `-Dlibasl_include=[]`: additional directories to search for the AMPL header files; -* `-Dlibhwloc_path=[]`: additional directories to search for the HWLOC library; -* `-Dlibhwloc_include=[]`: additional directories to search for the HWLOC header files; * `-Dlibhsl_modules[]`: additional directories to search for the HSL modules; * `-Dlibcutest_modules[]`: additional directories to search for the CUTEst modules; * `-Dint64=false`: compile GALAHAD with 64-bit integer; * `-Dopenmp:true`: compile GALAHAD with OpenMP. -Non-default compilers can be selected by setting the `CC`, `CXX` and -`FC` shell variables. For instance, +Non-default compilers can be selected by setting the `CC` and `FC` shell variables. +For instance, ```shell -CC=icc CXX=icpc FC=ifort meson setup builddir/pc64.lnx.ifr -Dssids=false [options...] -CC=icx CXX=icpx FC=ifx meson setup builddir/pc64.lnx.ifx [options...] -CC=nvc CXX=nvc++ FC=nvfortran meson setup builddir/pc64.lnx.nvf -Dc_std=none -Dcpp_std=none [options...] +CC=icc FC=ifort meson setup builddir/pc64.lnx.ifr [options...] +CC=icx FC=ifx meson setup builddir/pc64.lnx.ifx [options...] +CC=nvc FC=nvfortran meson setup builddir/pc64.lnx.nvf -Dc_std=none [options...] ``` See https://mesonbuild.com/Reference-tables.html for supported compilers and linkers. @@ -314,7 +310,6 @@ When we do a new release of GALAHAD, we should update the `version` - `libgalahad_python_src`: C files for the Python interfaces; - `libgalahad_cutest_src`: Fortran files related to the CUTEst interfaces; - `galahad_cutest_binaries`: Fortran files that contain CUTEst programs; -- `libgalahad_cpp_src`: C++ files required by GALAHAD; - `libgalahad_cc_src`: C files required by GALAHAD; - `galahad_examples`: Fortran examples; - `galahad_tests`: Fortran tests; diff --git a/doc/src/bllsb.tex b/doc/src/bllsb.tex index 7f25d310a9..d66233dceb 100644 --- a/doc/src/bllsb.tex +++ b/doc/src/bllsb.tex @@ -708,10 +708,9 @@ \subsubsection{The derived data type for holding control and length 30, that specifies the external package to be used to solve any symmetric linear system that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'} +{\tt 'ma86'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'} and {\tt 'wsmp'}, -although only {\tt 'sils'} and, for OMP 4.0-compliant compilers, -{\tt 'ssids'} are installed by default. +although only {\tt 'sils'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. The default is {\tt symmetric\_linear\_solver = 'sils'}. diff --git a/doc/src/clls.tex b/doc/src/clls.tex index 817c1e8868..a03b3b0a88 100644 --- a/doc/src/clls.tex +++ b/doc/src/clls.tex @@ -838,10 +838,9 @@ \subsubsection{The derived data type for holding control and length 30, that specifies the external package to be used to solve any symmetric linear system that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'} +{\tt 'ma86'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'} and {\tt 'wsmp'}, -although only {\tt 'sils'} and, for OMP 4.0-compliant compilers, -{\tt 'ssids'} are installed by default. +although only {\tt 'sils'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. The default is {\tt symmetric\_linear\_solver = 'sils'}. diff --git a/doc/src/cro.tex b/doc/src/cro.tex index 301802e0ed..ee92a42c61 100644 --- a/doc/src/cro.tex +++ b/doc/src/cro.tex @@ -177,10 +177,9 @@ \subsubsection{The derived data type for holding control and length 30, that specifies the external package to be used to solve any symmetric linear system that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'} +{\tt 'ma86'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'} and {\tt 'wsmp'}, -although only {\tt 'sils'} and, for OMP 4.0-compliant compilers, -{\tt 'ssids'} are installed by default. +although only {\tt 'sils'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. The default is {\tt symmetric\_linear\_solver = 'sils'}, but we recommend {\tt 'ma97'} if it available. diff --git a/doc/src/dps.tex b/doc/src/dps.tex index 18f1a1357b..29361f47fe 100644 --- a/doc/src/dps.tex +++ b/doc/src/dps.tex @@ -294,10 +294,9 @@ \subsubsection{The derived data type for holding control and length 30, that specifies the external package to be used to solve any symmetric linear system that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'} +{\tt 'ma86'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'} and {\tt 'wsmp'}, -although only {\tt 'sils'} and, for OMP 4.0-compliant compilers, -{\tt 'ssids'} are installed by default. +although only {\tt 'sils'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. The default is {\tt symmetric\_linear\_solver = 'sils'}. diff --git a/doc/src/dqp_control.tex b/doc/src/dqp_control.tex index 0b0b648e74..b90bab82c9 100644 --- a/doc/src/dqp_control.tex +++ b/doc/src/dqp_control.tex @@ -252,7 +252,7 @@ and length 30, that specifies the external package to be used to solve any symmetric linear system that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'} +{\tt 'ma86'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'} and {\tt 'wsmp'}. See the documentation for the \galahad\ package {\tt SLS} for further details. Since {\tt 'sils'} does not currently provide the required Fredholm @@ -264,7 +264,7 @@ solve any symmetric positive-definite linear system that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'} +{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'} and {\tt 'wsmp'}. See the documentation for the \galahad\ package {\tt SLS} for further details. The default is {\tt definite\_linear\_solver = 'sils'}, diff --git a/doc/src/fdc.tex b/doc/src/fdc.tex index cb521134b8..cd2837829b 100644 --- a/doc/src/fdc.tex +++ b/doc/src/fdc.tex @@ -172,10 +172,9 @@ \subsubsection{The derived data type for holding control \character\ and length 30, that specifies the external package to be used to solve any symmetric linear system that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'} +{\tt 'ma86'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'} and {\tt 'wsmp'}, -although only {\tt 'sils'} and, for OMP 4.0-compliant compilers, -{\tt 'ssids'} are installed by default. +although only {\tt 'sils'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. The default is {\tt symmetric\_linear\_solver = 'sils'}, but we recommend {\tt 'ma97'} if it available. diff --git a/doc/src/galahad.cls b/doc/src/galahad.cls index 079fbf0778..3d5889eb3c 100644 --- a/doc/src/galahad.cls +++ b/doc/src/galahad.cls @@ -1092,7 +1092,7 @@ See {\tt https://www.galahad.rl.ac.uk/download/} for full details.}} \newcommand{\galerrmcsixtyone}{-69} \newcommand{\galerrmcsictyeight}{-70} \newcommand{\galerrmetis}{-71} -\newcommand{\galerrspral}{-72} +\newcommand{\galerrslblt}{-72} \newcommand{\galerrrepeated}{-73} \newcommand{\galerreval}{-78} \newcommand{\galerroptional}{-79} diff --git a/doc/src/galahad_pandoc.cls b/doc/src/galahad_pandoc.cls index b2ac15d5e2..dad74b4a24 100644 --- a/doc/src/galahad_pandoc.cls +++ b/doc/src/galahad_pandoc.cls @@ -423,7 +423,7 @@ See {\tt http://galahad.rl.ac.uk/galahad-www/cou.html} for full details.}} \newcommand{\galerrmcsixtyone}{-69} \newcommand{\galerrmcsictyeight}{-70} \newcommand{\galerrmetis}{-71} -\newcommand{\galerrspral}{-72} +\newcommand{\galerrslblt}{-72} \newcommand{\galerrrepeated}{-73} \newcommand{\galerreval}{-78} \newcommand{\galerroptional}{-79} diff --git a/doc/src/llsr.tex b/doc/src/llsr.tex index 63c7fadfe3..d6bd56a370 100644 --- a/doc/src/llsr.tex +++ b/doc/src/llsr.tex @@ -333,7 +333,7 @@ \subsubsection{The derived data type for holding control solve any symmetric positive-definite linear system that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt 'ssids'}, {\tt 'pardiso'} +{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt 'slblt'}, {\tt 'pardiso'} and {\tt 'wsmp'}. See the documentation for the \galahad\ package {\tt SLS} for further details. The default is {\tt definite\_linear\_solver = 'sils'}. diff --git a/doc/src/llst.tex b/doc/src/llst.tex index e1eee5b9ee..f2c161aef9 100644 --- a/doc/src/llst.tex +++ b/doc/src/llst.tex @@ -342,7 +342,7 @@ \subsubsection{The derived data type for holding control solve any symmetric positive-definite linear system that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt 'ssids'}, {\tt 'pardiso'} +{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt 'slblt'}, {\tt 'pardiso'} and {\tt 'wsmp'}. See the documentation for the \galahad\ package {\tt SLS} for further details. The default is {\tt definite\_linear\_solver = 'sils'}. diff --git a/doc/src/nrek.tex b/doc/src/nrek.tex index 06f5db0a5e..8c60edf0a8 100644 --- a/doc/src/nrek.tex +++ b/doc/src/nrek.tex @@ -319,12 +319,11 @@ \subsubsection{The derived data type for holding control solve any symmetric positive-definite linear system involving $\bmH$ that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'}, +{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'}, {\tt 'wsmp'}, {\tt 'sytr'}, {\tt 'potr'} and {\tt 'pbtr'} -although only {\tt 'sytr'}, {\tt 'potr'}, {\tt 'pbtr'} and, for -OMP 4.0-compliant compilers, {\tt 'ssids'} are installed by default. +although only {\tt 'sytr'}, {\tt 'potr'}, {\tt 'pbtr'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. -The default is {\tt linear\_solver = 'ssids'}, but we recommend +The default is {\tt linear\_solver = 'slblt'}, but we recommend {\tt 'pbtr'} instead if $\bmH$ is banded with a small bandwidth. \itt{linear\_solver\_for\_S} is a scalar variable of type default \character\ @@ -332,12 +331,11 @@ \subsubsection{The derived data type for holding control solve any symmetric positive-definite linear system involving the optional $\bmS$ that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'}, +{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'}, {\tt 'wsmp'}, {\tt 'sytr'}, {\tt 'potr'} and {\tt 'pbtr'} -although only {\tt 'sytr'}, {\tt 'potr'}, {\tt 'pbtr'} and, for -OMP 4.0-compliant compilers, {\tt 'ssids'} are installed by default. +although only {\tt 'sytr'}, {\tt 'potr'}, {\tt 'pbtr'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. -The default is {\tt linear\_solver = 'ssids'}, but we recommend +The default is {\tt linear\_solver = 'slblt'}, but we recommend {\tt 'pbtr'} instead if $\bmS$ is banded with a small bandwidth. \itt{prefix} is a scalar variable of type default \character\ diff --git a/doc/src/psls.tex b/doc/src/psls.tex index 09a5117c81..2b73049392 100644 --- a/doc/src/psls.tex +++ b/doc/src/psls.tex @@ -121,7 +121,7 @@ \subsection{Supported external solvers} {\tt HSL\_MA86} & left-looking & yes & no & OpenMP fully \\ {\tt HSL\_MA87} & left-looking & no & no & OpenMP fully \\ {\tt HSL\_MA97} & multifrontal & yes & no & OpenMP core \\ -{\tt SSIDS} & multifrontal & yes & no & CUDA core \\ +{\tt SLBLT} & multifrontal & yes & no & OpenMP core \\ {\tt PARDISO} & left-right-looking & yes & no & OpenMP fully \\ {\tt MKL\_PARDISO} & left-right-looking & yes & optionally & OpenMP fully \\ {\tt WSMP} & left-right-looking & yes & no & OpenMP fully \\ @@ -443,16 +443,15 @@ \subsubsection{The derived data type for holding control {\tt 'ma77'}, {\tt 'ma86'}, {\tt 'ma97'}, -{\tt 'ssids'}, +{\tt 'slblt'}, {\tt 'pardiso'} {\tt 'mkl\_pardiso'}, {\tt 'wsmp'} and {\tt 'sytr'}, -although only {\tt 'sils'}, {\tt 'sytr} and, for OMP 4.0-compliant compilers, -{\tt 'ssids'} are installed by default. +although only {\tt 'sils'}, {\tt 'sytr} and {\tt 'slblt'} are installed by default. See Table~\ref{solvers} and the documentation for the \galahad\ package {\tt SLS} for further details. -The default is {\tt symmetric\_linear\_solver = 'ssids'}. +The default is {\tt symmetric\_linear\_solver = 'slblt'}. \itt{definite\_linear\_solver} is a scalar variable of type default \character\ and length 30, that specifies the external package to be used to @@ -465,7 +464,7 @@ \subsubsection{The derived data type for holding control {\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, -{\tt 'ssids'}, +{\tt 'slblt'}, {\tt 'pardiso'} {\tt 'mkl\_pardiso'}, {\tt 'wsmp'}, @@ -473,11 +472,10 @@ \subsubsection{The derived data type for holding control {\tt 'potr'} and {\tt 'pbtr'}, although only {\tt 'sils'}, {\tt 'sytr'}, {\tt 'potr'}, {\tt 'pbtr'} -and, for OMP 4.0-compliant compilers, -{\tt 'ssids'} are installed by default. +and {\tt 'slblt'} are installed by default. See Table~\ref{solvers} and the documentation for the \galahad\ package {\tt SLS} for further details. -The default is {\tt definite\_linear\_solver = 'ssids'}. +The default is {\tt definite\_linear\_solver = 'slblt'}. \itt{prefix} is a scalar variable of type default \character\ and length 30, that may be used to provide a user-selected diff --git a/doc/src/qpa_control.tex b/doc/src/qpa_control.tex index e0118b7515..ba1d3e9c25 100644 --- a/doc/src/qpa_control.tex +++ b/doc/src/qpa_control.tex @@ -334,10 +334,9 @@ and length 30, that specifies the external package to be used to solve any symmetric linear system that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'} +{\tt 'ma86'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'} and {\tt 'wsmp'}, -although only {\tt 'sils'} and, for OMP 4.0-compliant compilers, -{\tt 'ssids'} are installed by default. +although only {\tt 'sils'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. The default is {\tt symmetric\_linear\_solver = 'sils'}. @@ -346,10 +345,9 @@ solve any symmetric positive-definite linear system that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'} +{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'} and {\tt 'wsmp'}, -although only {\tt 'sils'} and, for OMP 4.0-compliant compilers, -{\tt 'ssids'} are installed by default. +although only {\tt 'sils'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. The default is {\tt definite\_linear\_solver = 'sils'}. diff --git a/doc/src/rqs.tex b/doc/src/rqs.tex index eae2f20409..f7417ba30b 100644 --- a/doc/src/rqs.tex +++ b/doc/src/rqs.tex @@ -410,10 +410,9 @@ \subsubsection{The derived data type for holding control and length 30, that specifies the external package to be used to solve any symmetric linear system that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'} +{\tt 'ma86'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'} and {\tt 'wsmp'}, -although only {\tt 'sils'} and, for OMP 4.0-compliant compilers, -{\tt 'ssids'} are installed by default. +although only {\tt 'sils'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. The default is {\tt symmetric\_linear\_solver = 'sils'}. @@ -422,10 +421,9 @@ \subsubsection{The derived data type for holding control solve any symmetric positive-definite linear system that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'} +{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'} and {\tt 'wsmp'}, -although only {\tt 'sils'} and, for OMP 4.0-compliant compilers, -{\tt 'ssids'} are installed by default. +although only {\tt 'sils'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. The default is {\tt definite\_linear\_solver = 'sils'}. diff --git a/doc/src/sbls.tex b/doc/src/sbls.tex index 5a9434a50a..419df6488c 100644 --- a/doc/src/sbls.tex +++ b/doc/src/sbls.tex @@ -513,14 +513,13 @@ \subsubsection{The derived data type for holding control {\tt 'ma77'}, {\tt 'ma86'}, {\tt 'ma97'}, -{\tt 'ssids'}, +{\tt 'slblt'}, {\tt 'pardiso'}, {\tt 'wsmp'}, {\tt 'sytr'}, -although only {\tt 'sils'}, {\tt 'sytr'} and, for OMP 4.0-compliant compilers, -{\tt 'ssids'} are installed by default. +although only {\tt 'sils'}, {\tt 'sytr'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. -The default is {\tt symmetric\_linear\_solver = 'ssids'}. +The default is {\tt symmetric\_linear\_solver = 'slblt'}. \itt{definite\_linear\_solver} is a scalar variable of type default \character\ and length 30, that specifies the external package to be used to @@ -533,17 +532,16 @@ \subsubsection{The derived data type for holding control {\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, -{\tt 'ssids'}, +{\tt 'slblt'}, {\tt 'pardiso'}, {\tt 'mkl\_pardiso'}, {\tt 'wsmp'}, {\tt 'potr'} and {\tt 'pbtr'}, although only {\tt 'sils'}, {\tt 'potr'}, {\tt 'pbtr'} -and, for OMP 4.0-compliant compilers, -{\tt 'ssids'} are installed by default. +and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. -The default is {\tt definite\_linear\_solver = 'ssids'}. +The default is {\tt definite\_linear\_solver = 'slblt'}. \itt{unsymmetric\_linear\_solver} is a scalar variable of type default \character\ @@ -911,7 +909,7 @@ \subsubsection{The subroutine for applying the preconditioner} set to $b_j$. On successful exit, {\tt SOL} will contain the solution $( x^T \;\; y^T)^T$ to \req{ls}, that is {\tt SOL(}$i${\tt )}, $i = 1, \ldots,$ {\tt n} will give -$x_i$, and {\tt SOL(n}$+j${\tt )}, $j = 1,\ldots,$ {\tt m} will contain +$x_i$, and {\tt SOL(n}$+j${\tt )}, $j = 1,\ldots,$ {\tt m} will contain $y_j$. diff --git a/doc/src/sllsb.tex b/doc/src/sllsb.tex index 656bf86371..5f3e737bf9 100644 --- a/doc/src/sllsb.tex +++ b/doc/src/sllsb.tex @@ -822,10 +822,9 @@ \subsubsection{The derived data type for holding control and length 30, that specifies the external package to be used to solve any symmetric linear system that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'} +{\tt 'ma86'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'} and {\tt 'wsmp'}, -although only {\tt 'sils'} and, for OMP 4.0-compliant compilers, -{\tt 'ssids'} are installed by default. +although only {\tt 'sils'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. The default is {\tt symmetric\_linear\_solver = 'sils'}. diff --git a/doc/src/sls.tex b/doc/src/sls.tex index 3776a8085e..760061e1b1 100644 --- a/doc/src/sls.tex +++ b/doc/src/sls.tex @@ -26,13 +26,13 @@ solvers from HSL and elsewhere. Currently supported solvers include {\tt MA27/SILS}, {\tt HSL\_MA57}, {\tt HSL\_MA77} , {\tt HSL\_MA86}, {\tt HSL\_MA87} and {\tt HSL\_MA97} from {HSL}, -{\tt SSIDS} from {SPRAL}, +{\tt SLBLT} from {GALAHAD}, {\tt MUMPS} from Mumps Technologies, {\tt PARDISO} both from the Pardiso Project and Intel's MKL, {\tt PaStiX} from Inria, and {\tt WSMP} from the IBM alpha Works, as well as {\tt POTR}, {\tt SYTR} and {\tt SBTR} from LAPACK. -Note that, with the exception of {\tt SSIDS} and the Netlib +Note that, with the exception of {\tt SLBLT} and the Netlib reference LAPACK codes, {\bf the solvers themselves do not form part of this package and must be obtained separately.} @@ -157,7 +157,7 @@ \subsection{Supported external solvers} {\tt HSL\_MA86} & left-looking & yes & no & OpenMP fully \\ {\tt HSL\_MA87} & left-looking & no & no & OpenMP fully \\ {\tt HSL\_MA97} & multifrontal & yes & no & OpenMP core \\ -{\tt SSIDS} & multifrontal & yes & no & CUDA core \\ +{\tt SLBLT} & multifrontal & yes & no & OpenMP core \\ {\tt MUMPS} & multifrontal & yes & optionally & MPI \\ {\tt PARDISO} & left-right-looking & yes & no & OpenMP fully \\ {\tt MKL\_PARDISO} & left-right-looking & yes & optionally & OpenMP fully \\ @@ -1041,9 +1041,9 @@ \subsubsection{The derived data type for holding informational from {\tt HSL\_MA97}. See the documentation for {\tt HSL\_MA97} for further details. -\itt{ssids\_inform} is a scalar variable of type {\tt ssids\_inform\_type}, -that corresponds to the output value {\tt ssids\_inform} -from {\tt SSIDS}. See the documentation for {\tt SSIDS} for further +\itt{slblt\_inform} is a scalar variable of type {\tt slblt\_inform\_type}, +that corresponds to the output value {\tt slblt\_inform} +from {\tt SLBLT}. See the documentation for {\tt SLBLT} for further details. \itt{nodend\_inform} is a scalar variable of type {\tt nodend\_inform}, @@ -1196,10 +1196,9 @@ \subsubsection{The initialization subroutine}\label{subinit} the functionality of {\tt HSL\_MA57} but offers the option of parallel execution of core computations. -\itt{ssids} if the SPRAL solver {\tt SSIDS} is desired. This option offers -the functionality of {\tt HSL\_MA97} but additionally performs -core computations on a GPU if available. N.B., {\tt SSIDS} is only -supported for compilers that are OMP 4.0 compliant. +\itt{slblt} if the GALAHAD solver {\tt SLBLT} is desired. This option offers +the functionality of {\tt HSL\_MA97} with OpenMP-parallel execution of +core computations. \itt{mumps} if the Mumps Technologies solver {\tt MUMPS} (version 5.5.1 or above) is desired. Distributed parallel solution is offered with this choice. @@ -1564,7 +1563,7 @@ \subsubsection{The termination subroutine} & $\surd$ & $\times$ \\ {\tt HSL\_MA97} & $\surd$ & $\surd$ & $\surd$ & $\surd$ & $\surd$ & $\surd$ & $\surd$ & $\surd$ \\ -{\tt SSIDS} & $\surd$ & $\surd$ & $\surd$ & $\surd$ & $\surd$ +{\tt SLBLT} & $\surd$ & $\surd$ & $\surd$ & $\surd$ & $\surd$ & $\surd$ & $\times^1$ & $\times$ \\ {\tt MUMPS} & $\surd$ & $\times$ & $\times$ & $\times$ & $\times$ & $\times$ & $\times$ & $\times$ \\ @@ -2014,7 +2013,7 @@ \subsubsection{To read control parameters from a specification file} {\tt http://hsl.rl.ac.uk }. \noindent -The solver {\tt SSIDS} is a fork of part of the open-source SPRAL sparse-matrix +The solver {\tt SLBLT} is a fork of part of the open-source SPRAL sparse-matrix solver suite, and is available as part of \galahad. %To obtain {\tt SPRAL}, see % diff --git a/doc/src/ssls.tex b/doc/src/ssls.tex index db5b446957..fa567dcbe7 100644 --- a/doc/src/ssls.tex +++ b/doc/src/ssls.tex @@ -305,14 +305,13 @@ \subsubsection{The derived data type for holding control {\tt 'ma77'}, {\tt 'ma86'}, {\tt 'ma97'}, -{\tt 'ssids'}, +{\tt 'slblt'}, {\tt 'pardiso'}, {\tt 'wsmp'}, {\tt 'sytr'}, -although only {\tt 'sils'}, {\tt 'sytr'} and, for OMP 4.0-compliant compilers, -{\tt 'ssids'} are installed by default. +although only {\tt 'sils'}, {\tt 'sytr'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. -The default is {\tt symmetric\_linear\_solver = 'ssids'}. +The default is {\tt symmetric\_linear\_solver = 'slblt'}. \itt{prefix} is a scalar variable of type default \character\ and length 30, that may be used to provide a user-selected @@ -626,7 +625,7 @@ \subsubsection{The subroutine for solving linear systems involving $\bmK$} set to $b_j$. On successful exit, {\tt SOL} will contain the solution $( x^T \;\; y^T)^T$ to \req{ls}, that is {\tt SOL(}$i${\tt )}, $i = 1, \ldots,$ {\tt n} will give -$x_i$, and {\tt SOL(n}$+j${\tt )}, $j = 1,\ldots,$ {\tt m} will contain +$x_i$, and {\tt SOL(n}$+j${\tt )}, $j = 1,\ldots,$ {\tt m} will contain $y_j$. \itt{inform} is a scalar \intentout\ argument of type diff --git a/doc/src/symbols.tex b/doc/src/symbols.tex index 0251df579e..8748c6319c 100644 --- a/doc/src/symbols.tex +++ b/doc/src/symbols.tex @@ -266,7 +266,7 @@ {\tt GALAHAD\_error\_mc61} & - 69 \\ {\tt GALAHAD\_error\_mc68} & - 70 & {\tt GALAHAD\_error\_metis} & - 71 \\ -{\tt GALAHAD\_error\_spral} & - 72 & +{\tt GALAHAD\_error\_slblt} & - 72 & {\tt GALAHAD\_warning\_repeated\_entry} & - 73 \\ \hline \end{tabular} diff --git a/doc/src/trek.tex b/doc/src/trek.tex index f205f1ceea..80b0b06c24 100644 --- a/doc/src/trek.tex +++ b/doc/src/trek.tex @@ -319,12 +319,11 @@ \subsubsection{The derived data type for holding control solve any symmetric positive-definite linear system involving $\bmH$ that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'}, +{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'}, {\tt 'wsmp'}, {\tt 'sytr'}, {\tt 'potr'} and {\tt 'pbtr'} -although only {\tt 'sytr'}, {\tt 'potr'}, {\tt 'pbtr'} and, for -OMP 4.0-compliant compilers, {\tt 'ssids'} are installed by default. +although only {\tt 'sytr'}, {\tt 'potr'}, {\tt 'pbtr'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. -The default is {\tt linear\_solver = 'ssids'}, but we recommend +The default is {\tt linear\_solver = 'slblt'}, but we recommend {\tt 'pbtr'} instead if $\bmH$ is banded with a small bandwidth. \itt{linear\_solver\_for\_S} is a scalar variable of type default \character\ @@ -332,12 +331,11 @@ \subsubsection{The derived data type for holding control solve any symmetric positive-definite linear system involving the optional $\bmS$ that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'}, +{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'}, {\tt 'wsmp'}, {\tt 'sytr'}, {\tt 'potr'} and {\tt 'pbtr'} -although only {\tt 'sytr'}, {\tt 'potr'}, {\tt 'pbtr'} and, for -OMP 4.0-compliant compilers, {\tt 'ssids'} are installed by default. +although only {\tt 'sytr'}, {\tt 'potr'}, {\tt 'pbtr'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. -The default is {\tt linear\_solver = 'ssids'}, but we recommend +The default is {\tt linear\_solver = 'slblt'}, but we recommend {\tt 'pbtr'} instead if $\bmS$ is banded with a small bandwidth. \itt{prefix} is a scalar variable of type default \character\ diff --git a/doc/src/trs.tex b/doc/src/trs.tex index c15ebe51f3..ad9e64ba44 100644 --- a/doc/src/trs.tex +++ b/doc/src/trs.tex @@ -426,10 +426,9 @@ \subsubsection{The derived data type for holding control and length 30, that specifies the external package to be used to solve any symmetric linear system that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'} +{\tt 'ma86'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'} and {\tt 'wsmp'}, -although only {\tt 'sils'} and, for OMP 4.0-compliant compilers, -{\tt 'ssids'} are installed by default. +although only {\tt 'sils'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. The default is {\tt symmetric\_linear\_solver = 'sils'}. @@ -438,10 +437,9 @@ \subsubsection{The derived data type for holding control solve any symmetric positive-definite linear system that might arise. Current possible choices are {\tt 'sils'}, {\tt 'ma27'}, {\tt 'ma57'}, {\tt 'ma77'}, -{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt ssids}, {\tt 'pardiso'} +{\tt 'ma86'}, {\tt 'ma87'}, {\tt 'ma97'}, {\tt slblt}, {\tt 'pardiso'} and {\tt 'wsmp'}, -although only {\tt 'sils'} and, for OMP 4.0-compliant compilers, -{\tt 'ssids'} are installed by default. +although only {\tt 'sils'} and {\tt 'slblt'} are installed by default. See the documentation for the \galahad\ package {\tt SLS} for further details. The default is {\tt definite\_linear\_solver = 'sils'}. diff --git a/include/galahad.h b/include/galahad.h index 94c6cd56bc..209bef6eec 100644 --- a/include/galahad.h +++ b/include/galahad.h @@ -383,11 +383,11 @@ #include "galahad_sec.h" #include "galahad_sha.h" #include "galahad_sils.h" +#include "galahad_slblt.h" #include "galahad_slls.h" #include "galahad_sllsb.h" -#include "galahad_snls.h" #include "galahad_sls.h" -#include "galahad_ssids.h" +#include "galahad_snls.h" #include "galahad_ssls.h" #include "galahad_trb.h" #include "galahad_trek.h" diff --git a/include/galahad_c_double.h b/include/galahad_c_double.h index 52539dd39e..2687384cb9 100644 --- a/include/galahad_c_double.h +++ b/include/galahad_c_double.h @@ -2228,8 +2228,8 @@ void ugo_information_64(void **data, struct ugo_inform_type_64 *inform, int64_t void ugo_terminate(void **data, struct ugo_control_type *control, struct ugo_inform_type *inform); void ugo_terminate_64(void **data, struct ugo_control_type_64 *control, struct ugo_inform_type_64 *inform); -// C interface for SSIDS -struct ssids_control_type { +// C interface for SLBLT +struct slblt_control_type { int32_t array_base; int32_t print_level; int32_t unit_diagnostics; @@ -2238,26 +2238,21 @@ struct ssids_control_type { int32_t ordering; int32_t nemin; bool ignore_numa; - bool use_gpu; - bool gpu_only; - int64_t min_gpu_work; float max_load_inbalance; - float gpu_perf_coeff; int32_t scaling; int64_t small_subtree_threshold; - int32_t cpu_block_size; + int32_t block_size; bool action; int32_t pivot_method; double small; double u; struct nodend_control_type nodend_control; - int32_t nstream; double multiplier; float min_loadbalance; int32_t failed_pivot_method; }; -struct ssids_control_type_64 { +struct slblt_control_type_64 { int64_t array_base; int64_t print_level; int64_t unit_diagnostics; @@ -2266,26 +2261,21 @@ struct ssids_control_type_64 { int64_t ordering; int64_t nemin; bool ignore_numa; - bool use_gpu; - bool gpu_only; - int64_t min_gpu_work; float max_load_inbalance; - float gpu_perf_coeff; int64_t scaling; int64_t small_subtree_threshold; - int64_t cpu_block_size; + int64_t block_size; bool action; int64_t pivot_method; double small; double u; struct nodend_control_type_64 nodend_control; - int64_t nstream; double multiplier; float min_loadbalance; int64_t failed_pivot_method; }; -struct ssids_inform_type { +struct slblt_inform_type { int32_t flag; int32_t matrix_dup; int32_t matrix_missing_diag; @@ -2301,17 +2291,14 @@ struct ssids_inform_type { int32_t num_sup; int32_t num_two; int32_t stat; - int32_t cuda_error; - int32_t cublas_error; struct nodend_inform_type nodend_inform; int32_t not_first_pass; int32_t not_second_pass; int32_t nparts; - int64_t cpu_flops; - int64_t gpu_flops; + int64_t flops; }; -struct ssids_inform_type_64 { +struct slblt_inform_type_64 { int64_t flag; int64_t matrix_dup; int64_t matrix_missing_diag; @@ -2327,44 +2314,41 @@ struct ssids_inform_type_64 { int64_t num_sup; int64_t num_two; int64_t stat; - int64_t cuda_error; - int64_t cublas_error; struct nodend_inform_type_64 nodend_inform; int64_t not_first_pass; int64_t not_second_pass; int64_t nparts; - int64_t cpu_flops; - int64_t gpu_flops; -}; - -void ssids_default_control(struct ssids_control_type *control); -void ssids_default_control_64(struct ssids_control_type_64 *control); -void ssids_analyse(bool check, int32_t n, int32_t *order, int64_t *ptr, int32_t *row, double *val, void **akeep, struct ssids_control_type *control, struct ssids_inform_type *inform); -void ssids_analyse_64(bool check, int64_t n, int64_t *order, int64_t *ptr, int64_t *row, double *val, void **akeep, struct ssids_control_type_64 *control, struct ssids_inform_type_64 *inform); -void ssids_analyse_ptr32(bool check, int32_t n, int32_t *order, int32_t *ptr, int32_t *row, double *val, void **akeep, struct ssids_control_type *control, struct ssids_inform_type *inform); -void ssids_analyse_ptr32_64(bool check, int64_t n, int64_t *order, int64_t *ptr, int64_t *row, double *val, void **akeep, struct ssids_control_type_64 *control, struct ssids_inform_type_64 *inform); -void ssids_analyse_coord(int32_t n, int32_t *order, int64_t ne, int32_t *row, int32_t *col, double *val, void **akeep, struct ssids_control_type *control, struct ssids_inform_type *inform); -void ssids_analyse_coord_64(int64_t n, int64_t *order, int64_t ne, int64_t *row, int64_t *col, double *val, void **akeep, struct ssids_control_type_64 *control, struct ssids_inform_type_64 *inform); -void ssids_factor(bool posdef, int64_t *ptr, int32_t *row, double *val, double *scale, void *akeep, void **fkeep, struct ssids_control_type *control, struct ssids_inform_type *inform); -void ssids_factor_64(bool posdef, int64_t *ptr, int64_t *row, double *val, double *scale, void *akeep, void **fkeep, struct ssids_control_type_64 *control, struct ssids_inform_type_64 *inform); -void ssids_factor_ptr32(bool posdef, int32_t *ptr, int32_t *row, double *val, double *scale, void *akeep, void **fkeep, struct ssids_control_type *control, struct ssids_inform_type *inform); -void ssids_factor_ptr32_64(bool posdef, int64_t *ptr, int64_t *row, double *val, double *scale, void *akeep, void **fkeep, struct ssids_control_type_64 *control, struct ssids_inform_type_64 *inform); -void ssids_solve1(int32_t job, double *x1, void *akeep, void *fkeep, struct ssids_control_type *control, struct ssids_inform_type *inform); -void ssids_solve1_64(int64_t job, double *x1, void *akeep, void *fkeep, struct ssids_control_type_64 *control, struct ssids_inform_type_64 *inform); -void ssids_solve(int32_t job, int32_t nrhs, double *x, int32_t ldx, void *akeep, void *fkeep, struct ssids_control_type *control, struct ssids_inform_type *inform); -void ssids_solve_64(int64_t job, int64_t nrhs, double *x, int64_t ldx, void *akeep, void *fkeep, struct ssids_control_type_64 *control, struct ssids_inform_type_64 *inform); -int32_t ssids_free_akeep(void **akeep); -int64_t ssids_free_akeep_64(void **akeep); -int32_t ssids_free_fkeep(void **fkeep); -int64_t ssids_free_fkeep_64(void **fkeep); -int32_t ssids_free(void **akeep, void **fkeep); -int64_t ssids_free_64(void **akeep, void **fkeep); -void ssids_enquire_posdef(void *akeep, void *fkeep, struct ssids_control_type *control, struct ssids_inform_type *inform, double *d); -void ssids_enquire_posdef_64(void *akeep, void *fkeep, struct ssids_control_type_64 *control, struct ssids_inform_type_64 *inform, double *d); -void ssids_enquire_indef(void *akeep, void *fkeep, struct ssids_control_type *control, struct ssids_inform_type *inform, int32_t *piv_order, double *d); -void ssids_enquire_indef_64(void *akeep, void *fkeep, struct ssids_control_type_64 *control, struct ssids_inform_type_64 *inform, int64_t *piv_order, double *d); -void ssids_alter(double *d, void *akeep, void *fkeep, struct ssids_control_type *control, struct ssids_inform_type *inform); -void ssids_alter_64(double *d, void *akeep, void *fkeep, struct ssids_control_type_64 *control, struct ssids_inform_type_64 *inform); + int64_t flops; +}; + +void slblt_default_control(struct slblt_control_type *control); +void slblt_default_control_64(struct slblt_control_type_64 *control); +void slblt_analyse(bool check, int32_t n, int32_t *order, int64_t *ptr, int32_t *row, double *val, void **akeep, struct slblt_control_type *control, struct slblt_inform_type *inform); +void slblt_analyse_64(bool check, int64_t n, int64_t *order, int64_t *ptr, int64_t *row, double *val, void **akeep, struct slblt_control_type_64 *control, struct slblt_inform_type_64 *inform); +void slblt_analyse_ptr32(bool check, int32_t n, int32_t *order, int32_t *ptr, int32_t *row, double *val, void **akeep, struct slblt_control_type *control, struct slblt_inform_type *inform); +void slblt_analyse_ptr32_64(bool check, int64_t n, int64_t *order, int64_t *ptr, int64_t *row, double *val, void **akeep, struct slblt_control_type_64 *control, struct slblt_inform_type_64 *inform); +void slblt_analyse_coord(int32_t n, int32_t *order, int64_t ne, int32_t *row, int32_t *col, double *val, void **akeep, struct slblt_control_type *control, struct slblt_inform_type *inform); +void slblt_analyse_coord_64(int64_t n, int64_t *order, int64_t ne, int64_t *row, int64_t *col, double *val, void **akeep, struct slblt_control_type_64 *control, struct slblt_inform_type_64 *inform); +void slblt_factor(bool posdef, int64_t *ptr, int32_t *row, double *val, double *scale, void *akeep, void **fkeep, struct slblt_control_type *control, struct slblt_inform_type *inform); +void slblt_factor_64(bool posdef, int64_t *ptr, int64_t *row, double *val, double *scale, void *akeep, void **fkeep, struct slblt_control_type_64 *control, struct slblt_inform_type_64 *inform); +void slblt_factor_ptr32(bool posdef, int32_t *ptr, int32_t *row, double *val, double *scale, void *akeep, void **fkeep, struct slblt_control_type *control, struct slblt_inform_type *inform); +void slblt_factor_ptr32_64(bool posdef, int64_t *ptr, int64_t *row, double *val, double *scale, void *akeep, void **fkeep, struct slblt_control_type_64 *control, struct slblt_inform_type_64 *inform); +void slblt_solve1(int32_t job, double *x1, void *akeep, void *fkeep, struct slblt_control_type *control, struct slblt_inform_type *inform); +void slblt_solve1_64(int64_t job, double *x1, void *akeep, void *fkeep, struct slblt_control_type_64 *control, struct slblt_inform_type_64 *inform); +void slblt_solve(int32_t job, int32_t nrhs, double *x, int32_t ldx, void *akeep, void *fkeep, struct slblt_control_type *control, struct slblt_inform_type *inform); +void slblt_solve_64(int64_t job, int64_t nrhs, double *x, int64_t ldx, void *akeep, void *fkeep, struct slblt_control_type_64 *control, struct slblt_inform_type_64 *inform); +int32_t slblt_free_akeep(void **akeep); +int64_t slblt_free_akeep_64(void **akeep); +int32_t slblt_free_fkeep(void **fkeep); +int64_t slblt_free_fkeep_64(void **fkeep); +int32_t slblt_free(void **akeep, void **fkeep); +int64_t slblt_free_64(void **akeep, void **fkeep); +void slblt_enquire_posdef(void *akeep, void *fkeep, struct slblt_control_type *control, struct slblt_inform_type *inform, double *d); +void slblt_enquire_posdef_64(void *akeep, void *fkeep, struct slblt_control_type_64 *control, struct slblt_inform_type_64 *inform, double *d); +void slblt_enquire_indef(void *akeep, void *fkeep, struct slblt_control_type *control, struct slblt_inform_type *inform, int32_t *piv_order, double *d); +void slblt_enquire_indef_64(void *akeep, void *fkeep, struct slblt_control_type_64 *control, struct slblt_inform_type_64 *inform, int64_t *piv_order, double *d); +void slblt_alter(double *d, void *akeep, void *fkeep, struct slblt_control_type *control, struct slblt_inform_type *inform); +void slblt_alter_64(double *d, void *akeep, void *fkeep, struct slblt_control_type_64 *control, struct slblt_inform_type_64 *inform); // C interface for SLS struct sls_control_type { @@ -2553,7 +2537,7 @@ struct sls_inform_type { struct ma86_info ma86_info; struct ma87_info ma87_info; struct ma97_info ma97_info; - struct ssids_inform_type ssids_inform; + struct slblt_inform_type slblt_inform; struct nodend_inform_type nodend_inform; int32_t mc61_info[10]; double mc61_rinfo[15]; @@ -2634,7 +2618,7 @@ struct sls_inform_type_64 { struct ma86_info_64 ma86_info; struct ma87_info_64 ma87_info; struct ma97_info_64 ma97_info; - struct ssids_inform_type_64 ssids_inform; + struct slblt_inform_type_64 slblt_inform; struct nodend_inform_type_64 nodend_inform; int64_t mc61_info[10]; double mc61_rinfo[15]; diff --git a/include/galahad_c_quadruple.h b/include/galahad_c_quadruple.h index b98e478763..be582da2d0 100644 --- a/include/galahad_c_quadruple.h +++ b/include/galahad_c_quadruple.h @@ -2228,8 +2228,8 @@ void ugo_information_q_64(void **data, struct ugo_inform_type_q_64 *inform, int6 void ugo_terminate_q(void **data, struct ugo_control_type_q *control, struct ugo_inform_type_q *inform); void ugo_terminate_q_64(void **data, struct ugo_control_type_q_64 *control, struct ugo_inform_type_q_64 *inform); -// C interface for SSIDS -struct ssids_control_type_q { +// C interface for SLBLT +struct slblt_control_type_q { int32_t array_base; int32_t print_level; int32_t unit_diagnostics; @@ -2238,26 +2238,21 @@ struct ssids_control_type_q { int32_t ordering; int32_t nemin; bool ignore_numa; - bool use_gpu; - bool gpu_only; - int64_t min_gpu_work; float max_load_inbalance; - float gpu_perf_coeff; int32_t scaling; int64_t small_subtree_threshold; - int32_t cpu_block_size; + int32_t block_size; bool action; int32_t pivot_method; __float128 small; __float128 u; struct nodend_control_type nodend_control; - int32_t nstream; __float128 multiplier; float min_loadbalance; int32_t failed_pivot_method; }; -struct ssids_control_type_q_64 { +struct slblt_control_type_q_64 { int64_t array_base; int64_t print_level; int64_t unit_diagnostics; @@ -2266,26 +2261,21 @@ struct ssids_control_type_q_64 { int64_t ordering; int64_t nemin; bool ignore_numa; - bool use_gpu; - bool gpu_only; - int64_t min_gpu_work; float max_load_inbalance; - float gpu_perf_coeff; int64_t scaling; int64_t small_subtree_threshold; - int64_t cpu_block_size; + int64_t block_size; bool action; int64_t pivot_method; __float128 small; __float128 u; struct nodend_control_type_64 nodend_control; - int64_t nstream; __float128 multiplier; float min_loadbalance; int64_t failed_pivot_method; }; -struct ssids_inform_type_q { +struct slblt_inform_type_q { int32_t flag; int32_t matrix_dup; int32_t matrix_missing_diag; @@ -2301,17 +2291,14 @@ struct ssids_inform_type_q { int32_t num_sup; int32_t num_two; int32_t stat; - int32_t cuda_error; - int32_t cublas_error; struct nodend_inform_type_q nodend_inform; int32_t not_first_pass; int32_t not_second_pass; int32_t nparts; - int64_t cpu_flops; - int64_t gpu_flops; + int64_t flops; }; -struct ssids_inform_type_q_64 { +struct slblt_inform_type_q_64 { int64_t flag; int64_t matrix_dup; int64_t matrix_missing_diag; @@ -2327,44 +2314,41 @@ struct ssids_inform_type_q_64 { int64_t num_sup; int64_t num_two; int64_t stat; - int64_t cuda_error; - int64_t cublas_error; struct nodend_inform_type_q_64 nodend_inform; int64_t not_first_pass; int64_t not_second_pass; int64_t nparts; - int64_t cpu_flops; - int64_t gpu_flops; -}; - -void ssids_default_control_q(struct ssids_control_type_q *control); -void ssids_default_control_q_64(struct ssids_control_type_q_64 *control); -void ssids_analyse_q(bool check, int32_t n, int32_t *order, int64_t *ptr, int32_t *row, __float128 *val, void **akeep, struct ssids_control_type_q *control, struct ssids_inform_type_q *inform); -void ssids_analyse_q_64(bool check, int64_t n, int64_t *order, int64_t *ptr, int64_t *row, __float128 *val, void **akeep, struct ssids_control_type_q_64 *control, struct ssids_inform_type_q_64 *inform); -void ssids_analyse_ptr32_q(bool check, int32_t n, int32_t *order, int32_t *ptr, int32_t *row, __float128 *val, void **akeep, struct ssids_control_type_q *control, struct ssids_inform_type_q *inform); -void ssids_analyse_ptr32_q_64(bool check, int64_t n, int64_t *order, int64_t *ptr, int64_t *row, __float128 *val, void **akeep, struct ssids_control_type_q_64 *control, struct ssids_inform_type_q_64 *inform); -void ssids_analyse_coord_q(int32_t n, int32_t *order, int64_t ne, int32_t *row, int32_t *col, __float128 *val, void **akeep, struct ssids_control_type_q *control, struct ssids_inform_type_q *inform); -void ssids_analyse_coord_q_64(int64_t n, int64_t *order, int64_t ne, int64_t *row, int64_t *col, __float128 *val, void **akeep, struct ssids_control_type_q_64 *control, struct ssids_inform_type_q_64 *inform); -void ssids_factor_q(bool posdef, int64_t *ptr, int32_t *row, __float128 *val, __float128 *scale, void *akeep, void **fkeep, struct ssids_control_type_q *control, struct ssids_inform_type_q *inform); -void ssids_factor_q_64(bool posdef, int64_t *ptr, int64_t *row, __float128 *val, __float128 *scale, void *akeep, void **fkeep, struct ssids_control_type_q_64 *control, struct ssids_inform_type_q_64 *inform); -void ssids_factor_ptr32_q(bool posdef, int32_t *ptr, int32_t *row, __float128 *val, __float128 *scale, void *akeep, void **fkeep, struct ssids_control_type_q *control, struct ssids_inform_type_q *inform); -void ssids_factor_ptr32_q_64(bool posdef, int64_t *ptr, int64_t *row, __float128 *val, __float128 *scale, void *akeep, void **fkeep, struct ssids_control_type_q_64 *control, struct ssids_inform_type_q_64 *inform); -void ssids_solve1_q(int32_t job, __float128 *x1, void *akeep, void *fkeep, struct ssids_control_type_q *control, struct ssids_inform_type_q *inform); -void ssids_solve1_q_64(int64_t job, __float128 *x1, void *akeep, void *fkeep, struct ssids_control_type_q_64 *control, struct ssids_inform_type_q_64 *inform); -void ssids_solve_q(int32_t job, int32_t nrhs, __float128 *x, int32_t ldx, void *akeep, void *fkeep, struct ssids_control_type_q *control, struct ssids_inform_type_q *inform); -void ssids_solve_q_64(int64_t job, int64_t nrhs, __float128 *x, int64_t ldx, void *akeep, void *fkeep, struct ssids_control_type_q_64 *control, struct ssids_inform_type_q_64 *inform); -int32_t ssids_free_akeep_q(void **akeep); -int64_t ssids_free_akeep_q_64(void **akeep); -int32_t ssids_free_fkeep_q(void **fkeep); -int64_t ssids_free_fkeep_q_64(void **fkeep); -int32_t ssids_free_q(void **akeep, void **fkeep); -int64_t ssids_free_q_64(void **akeep, void **fkeep); -void ssids_enquire_posdef_q(void *akeep, void *fkeep, struct ssids_control_type_q *control, struct ssids_inform_type_q *inform, __float128 *d); -void ssids_enquire_posdef_q_64(void *akeep, void *fkeep, struct ssids_control_type_q_64 *control, struct ssids_inform_type_q_64 *inform, __float128 *d); -void ssids_enquire_indef_q(void *akeep, void *fkeep, struct ssids_control_type_q *control, struct ssids_inform_type_q *inform, int32_t *piv_order, __float128 *d); -void ssids_enquire_indef_q_64(void *akeep, void *fkeep, struct ssids_control_type_q_64 *control, struct ssids_inform_type_q_64 *inform, int64_t *piv_order, __float128 *d); -void ssids_alter_q(__float128 *d, void *akeep, void *fkeep, struct ssids_control_type_q *control, struct ssids_inform_type_q *inform); -void ssids_alter_q_64(__float128 *d, void *akeep, void *fkeep, struct ssids_control_type_q_64 *control, struct ssids_inform_type_q_64 *inform); + int64_t flops; +}; + +void slblt_default_control_q(struct slblt_control_type_q *control); +void slblt_default_control_q_64(struct slblt_control_type_q_64 *control); +void slblt_analyse_q(bool check, int32_t n, int32_t *order, int64_t *ptr, int32_t *row, __float128 *val, void **akeep, struct slblt_control_type_q *control, struct slblt_inform_type_q *inform); +void slblt_analyse_q_64(bool check, int64_t n, int64_t *order, int64_t *ptr, int64_t *row, __float128 *val, void **akeep, struct slblt_control_type_q_64 *control, struct slblt_inform_type_q_64 *inform); +void slblt_analyse_ptr32_q(bool check, int32_t n, int32_t *order, int32_t *ptr, int32_t *row, __float128 *val, void **akeep, struct slblt_control_type_q *control, struct slblt_inform_type_q *inform); +void slblt_analyse_ptr32_q_64(bool check, int64_t n, int64_t *order, int64_t *ptr, int64_t *row, __float128 *val, void **akeep, struct slblt_control_type_q_64 *control, struct slblt_inform_type_q_64 *inform); +void slblt_analyse_coord_q(int32_t n, int32_t *order, int64_t ne, int32_t *row, int32_t *col, __float128 *val, void **akeep, struct slblt_control_type_q *control, struct slblt_inform_type_q *inform); +void slblt_analyse_coord_q_64(int64_t n, int64_t *order, int64_t ne, int64_t *row, int64_t *col, __float128 *val, void **akeep, struct slblt_control_type_q_64 *control, struct slblt_inform_type_q_64 *inform); +void slblt_factor_q(bool posdef, int64_t *ptr, int32_t *row, __float128 *val, __float128 *scale, void *akeep, void **fkeep, struct slblt_control_type_q *control, struct slblt_inform_type_q *inform); +void slblt_factor_q_64(bool posdef, int64_t *ptr, int64_t *row, __float128 *val, __float128 *scale, void *akeep, void **fkeep, struct slblt_control_type_q_64 *control, struct slblt_inform_type_q_64 *inform); +void slblt_factor_ptr32_q(bool posdef, int32_t *ptr, int32_t *row, __float128 *val, __float128 *scale, void *akeep, void **fkeep, struct slblt_control_type_q *control, struct slblt_inform_type_q *inform); +void slblt_factor_ptr32_q_64(bool posdef, int64_t *ptr, int64_t *row, __float128 *val, __float128 *scale, void *akeep, void **fkeep, struct slblt_control_type_q_64 *control, struct slblt_inform_type_q_64 *inform); +void slblt_solve1_q(int32_t job, __float128 *x1, void *akeep, void *fkeep, struct slblt_control_type_q *control, struct slblt_inform_type_q *inform); +void slblt_solve1_q_64(int64_t job, __float128 *x1, void *akeep, void *fkeep, struct slblt_control_type_q_64 *control, struct slblt_inform_type_q_64 *inform); +void slblt_solve_q(int32_t job, int32_t nrhs, __float128 *x, int32_t ldx, void *akeep, void *fkeep, struct slblt_control_type_q *control, struct slblt_inform_type_q *inform); +void slblt_solve_q_64(int64_t job, int64_t nrhs, __float128 *x, int64_t ldx, void *akeep, void *fkeep, struct slblt_control_type_q_64 *control, struct slblt_inform_type_q_64 *inform); +int32_t slblt_free_akeep_q(void **akeep); +int64_t slblt_free_akeep_q_64(void **akeep); +int32_t slblt_free_fkeep_q(void **fkeep); +int64_t slblt_free_fkeep_q_64(void **fkeep); +int32_t slblt_free_q(void **akeep, void **fkeep); +int64_t slblt_free_q_64(void **akeep, void **fkeep); +void slblt_enquire_posdef_q(void *akeep, void *fkeep, struct slblt_control_type_q *control, struct slblt_inform_type_q *inform, __float128 *d); +void slblt_enquire_posdef_q_64(void *akeep, void *fkeep, struct slblt_control_type_q_64 *control, struct slblt_inform_type_q_64 *inform, __float128 *d); +void slblt_enquire_indef_q(void *akeep, void *fkeep, struct slblt_control_type_q *control, struct slblt_inform_type_q *inform, int32_t *piv_order, __float128 *d); +void slblt_enquire_indef_q_64(void *akeep, void *fkeep, struct slblt_control_type_q_64 *control, struct slblt_inform_type_q_64 *inform, int64_t *piv_order, __float128 *d); +void slblt_alter_q(__float128 *d, void *akeep, void *fkeep, struct slblt_control_type_q *control, struct slblt_inform_type_q *inform); +void slblt_alter_q_64(__float128 *d, void *akeep, void *fkeep, struct slblt_control_type_q_64 *control, struct slblt_inform_type_q_64 *inform); // C interface for SLS struct sls_control_type_q { @@ -2553,7 +2537,7 @@ struct sls_inform_type_q { struct ma86_info_q ma86_info; struct ma87_info_q ma87_info; struct ma97_info_q ma97_info; - struct ssids_inform_type_q ssids_inform; + struct slblt_inform_type_q slblt_inform; struct nodend_inform_type_q nodend_inform; int32_t mc61_info[10]; __float128 mc61_rinfo[15]; @@ -2634,7 +2618,7 @@ struct sls_inform_type_q_64 { struct ma86_info_q_64 ma86_info; struct ma87_info_q_64 ma87_info; struct ma97_info_q_64 ma97_info; - struct ssids_inform_type_q_64 ssids_inform; + struct slblt_inform_type_q_64 slblt_inform; struct nodend_inform_type_q_64 nodend_inform; int64_t mc61_info[10]; __float128 mc61_rinfo[15]; diff --git a/include/galahad_c_single.h b/include/galahad_c_single.h index c31b296ce8..cc8b35cef7 100644 --- a/include/galahad_c_single.h +++ b/include/galahad_c_single.h @@ -2228,8 +2228,8 @@ void ugo_information_s_64(void **data, struct ugo_inform_type_s_64 *inform, int6 void ugo_terminate_s(void **data, struct ugo_control_type_s *control, struct ugo_inform_type_s *inform); void ugo_terminate_s_64(void **data, struct ugo_control_type_s_64 *control, struct ugo_inform_type_s_64 *inform); -// C interface for SSIDS -struct ssids_control_type_s { +// C interface for SLBLT +struct slblt_control_type_s { int32_t array_base; int32_t print_level; int32_t unit_diagnostics; @@ -2238,26 +2238,21 @@ struct ssids_control_type_s { int32_t ordering; int32_t nemin; bool ignore_numa; - bool use_gpu; - bool gpu_only; - int64_t min_gpu_work; float max_load_inbalance; - float gpu_perf_coeff; int32_t scaling; int64_t small_subtree_threshold; - int32_t cpu_block_size; + int32_t block_size; bool action; int32_t pivot_method; float small; float u; struct nodend_control_type nodend_control; - int32_t nstream; float multiplier; float min_loadbalance; int32_t failed_pivot_method; }; -struct ssids_control_type_s_64 { +struct slblt_control_type_s_64 { int64_t array_base; int64_t print_level; int64_t unit_diagnostics; @@ -2266,26 +2261,21 @@ struct ssids_control_type_s_64 { int64_t ordering; int64_t nemin; bool ignore_numa; - bool use_gpu; - bool gpu_only; - int64_t min_gpu_work; float max_load_inbalance; - float gpu_perf_coeff; int64_t scaling; int64_t small_subtree_threshold; - int64_t cpu_block_size; + int64_t block_size; bool action; int64_t pivot_method; float small; float u; struct nodend_control_type_64 nodend_control; - int64_t nstream; float multiplier; float min_loadbalance; int64_t failed_pivot_method; }; -struct ssids_inform_type_s { +struct slblt_inform_type_s { int32_t flag; int32_t matrix_dup; int32_t matrix_missing_diag; @@ -2301,17 +2291,14 @@ struct ssids_inform_type_s { int32_t num_sup; int32_t num_two; int32_t stat; - int32_t cuda_error; - int32_t cublas_error; struct nodend_inform_type_s nodend_inform; int32_t not_first_pass; int32_t not_second_pass; int32_t nparts; - int64_t cpu_flops; - int64_t gpu_flops; + int64_t flops; }; -struct ssids_inform_type_s_64 { +struct slblt_inform_type_s_64 { int64_t flag; int64_t matrix_dup; int64_t matrix_missing_diag; @@ -2327,44 +2314,41 @@ struct ssids_inform_type_s_64 { int64_t num_sup; int64_t num_two; int64_t stat; - int64_t cuda_error; - int64_t cublas_error; struct nodend_inform_type_s_64 nodend_inform; int64_t not_first_pass; int64_t not_second_pass; int64_t nparts; - int64_t cpu_flops; - int64_t gpu_flops; -}; - -void ssids_default_control_s(struct ssids_control_type_s *control); -void ssids_default_control_s_64(struct ssids_control_type_s_64 *control); -void ssids_analyse_s(bool check, int32_t n, int32_t *order, int64_t *ptr, int32_t *row, float *val, void **akeep, struct ssids_control_type_s *control, struct ssids_inform_type_s *inform); -void ssids_analyse_s_64(bool check, int64_t n, int64_t *order, int64_t *ptr, int64_t *row, float *val, void **akeep, struct ssids_control_type_s_64 *control, struct ssids_inform_type_s_64 *inform); -void ssids_analyse_ptr32_s(bool check, int32_t n, int32_t *order, int32_t *ptr, int32_t *row, float *val, void **akeep, struct ssids_control_type_s *control, struct ssids_inform_type_s *inform); -void ssids_analyse_ptr32_s_64(bool check, int64_t n, int64_t *order, int64_t *ptr, int64_t *row, float *val, void **akeep, struct ssids_control_type_s_64 *control, struct ssids_inform_type_s_64 *inform); -void ssids_analyse_coord_s(int32_t n, int32_t *order, int64_t ne, int32_t *row, int32_t *col, float *val, void **akeep, struct ssids_control_type_s *control, struct ssids_inform_type_s *inform); -void ssids_analyse_coord_s_64(int64_t n, int64_t *order, int64_t ne, int64_t *row, int64_t *col, float *val, void **akeep, struct ssids_control_type_s_64 *control, struct ssids_inform_type_s_64 *inform); -void ssids_factor_s(bool posdef, int64_t *ptr, int32_t *row, float *val, float *scale, void *akeep, void **fkeep, struct ssids_control_type_s *control, struct ssids_inform_type_s *inform); -void ssids_factor_s_64(bool posdef, int64_t *ptr, int64_t *row, float *val, float *scale, void *akeep, void **fkeep, struct ssids_control_type_s_64 *control, struct ssids_inform_type_s_64 *inform); -void ssids_factor_ptr32_s(bool posdef, int32_t *ptr, int32_t *row, float *val, float *scale, void *akeep, void **fkeep, struct ssids_control_type_s *control, struct ssids_inform_type_s *inform); -void ssids_factor_ptr32_s_64(bool posdef, int64_t *ptr, int64_t *row, float *val, float *scale, void *akeep, void **fkeep, struct ssids_control_type_s_64 *control, struct ssids_inform_type_s_64 *inform); -void ssids_solve1_s(int32_t job, float *x1, void *akeep, void *fkeep, struct ssids_control_type_s *control, struct ssids_inform_type_s *inform); -void ssids_solve1_s_64(int64_t job, float *x1, void *akeep, void *fkeep, struct ssids_control_type_s_64 *control, struct ssids_inform_type_s_64 *inform); -void ssids_solve_s(int32_t job, int32_t nrhs, float *x, int32_t ldx, void *akeep, void *fkeep, struct ssids_control_type_s *control, struct ssids_inform_type_s *inform); -void ssids_solve_s_64(int64_t job, int64_t nrhs, float *x, int64_t ldx, void *akeep, void *fkeep, struct ssids_control_type_s_64 *control, struct ssids_inform_type_s_64 *inform); -int32_t ssids_free_akeep_s(void **akeep); -int64_t ssids_free_akeep_s_64(void **akeep); -int32_t ssids_free_fkeep_s(void **fkeep); -int64_t ssids_free_fkeep_s_64(void **fkeep); -int32_t ssids_free_s(void **akeep, void **fkeep); -int64_t ssids_free_s_64(void **akeep, void **fkeep); -void ssids_enquire_posdef_s(void *akeep, void *fkeep, struct ssids_control_type_s *control, struct ssids_inform_type_s *inform, float *d); -void ssids_enquire_posdef_s_64(void *akeep, void *fkeep, struct ssids_control_type_s_64 *control, struct ssids_inform_type_s_64 *inform, float *d); -void ssids_enquire_indef_s(void *akeep, void *fkeep, struct ssids_control_type_s *control, struct ssids_inform_type_s *inform, int32_t *piv_order, float *d); -void ssids_enquire_indef_s_64(void *akeep, void *fkeep, struct ssids_control_type_s_64 *control, struct ssids_inform_type_s_64 *inform, int64_t *piv_order, float *d); -void ssids_alter_s(float *d, void *akeep, void *fkeep, struct ssids_control_type_s *control, struct ssids_inform_type_s *inform); -void ssids_alter_s_64(float *d, void *akeep, void *fkeep, struct ssids_control_type_s_64 *control, struct ssids_inform_type_s_64 *inform); + int64_t flops; +}; + +void slblt_default_control_s(struct slblt_control_type_s *control); +void slblt_default_control_s_64(struct slblt_control_type_s_64 *control); +void slblt_analyse_s(bool check, int32_t n, int32_t *order, int64_t *ptr, int32_t *row, float *val, void **akeep, struct slblt_control_type_s *control, struct slblt_inform_type_s *inform); +void slblt_analyse_s_64(bool check, int64_t n, int64_t *order, int64_t *ptr, int64_t *row, float *val, void **akeep, struct slblt_control_type_s_64 *control, struct slblt_inform_type_s_64 *inform); +void slblt_analyse_ptr32_s(bool check, int32_t n, int32_t *order, int32_t *ptr, int32_t *row, float *val, void **akeep, struct slblt_control_type_s *control, struct slblt_inform_type_s *inform); +void slblt_analyse_ptr32_s_64(bool check, int64_t n, int64_t *order, int64_t *ptr, int64_t *row, float *val, void **akeep, struct slblt_control_type_s_64 *control, struct slblt_inform_type_s_64 *inform); +void slblt_analyse_coord_s(int32_t n, int32_t *order, int64_t ne, int32_t *row, int32_t *col, float *val, void **akeep, struct slblt_control_type_s *control, struct slblt_inform_type_s *inform); +void slblt_analyse_coord_s_64(int64_t n, int64_t *order, int64_t ne, int64_t *row, int64_t *col, float *val, void **akeep, struct slblt_control_type_s_64 *control, struct slblt_inform_type_s_64 *inform); +void slblt_factor_s(bool posdef, int64_t *ptr, int32_t *row, float *val, float *scale, void *akeep, void **fkeep, struct slblt_control_type_s *control, struct slblt_inform_type_s *inform); +void slblt_factor_s_64(bool posdef, int64_t *ptr, int64_t *row, float *val, float *scale, void *akeep, void **fkeep, struct slblt_control_type_s_64 *control, struct slblt_inform_type_s_64 *inform); +void slblt_factor_ptr32_s(bool posdef, int32_t *ptr, int32_t *row, float *val, float *scale, void *akeep, void **fkeep, struct slblt_control_type_s *control, struct slblt_inform_type_s *inform); +void slblt_factor_ptr32_s_64(bool posdef, int64_t *ptr, int64_t *row, float *val, float *scale, void *akeep, void **fkeep, struct slblt_control_type_s_64 *control, struct slblt_inform_type_s_64 *inform); +void slblt_solve1_s(int32_t job, float *x1, void *akeep, void *fkeep, struct slblt_control_type_s *control, struct slblt_inform_type_s *inform); +void slblt_solve1_s_64(int64_t job, float *x1, void *akeep, void *fkeep, struct slblt_control_type_s_64 *control, struct slblt_inform_type_s_64 *inform); +void slblt_solve_s(int32_t job, int32_t nrhs, float *x, int32_t ldx, void *akeep, void *fkeep, struct slblt_control_type_s *control, struct slblt_inform_type_s *inform); +void slblt_solve_s_64(int64_t job, int64_t nrhs, float *x, int64_t ldx, void *akeep, void *fkeep, struct slblt_control_type_s_64 *control, struct slblt_inform_type_s_64 *inform); +int32_t slblt_free_akeep_s(void **akeep); +int64_t slblt_free_akeep_s_64(void **akeep); +int32_t slblt_free_fkeep_s(void **fkeep); +int64_t slblt_free_fkeep_s_64(void **fkeep); +int32_t slblt_free_s(void **akeep, void **fkeep); +int64_t slblt_free_s_64(void **akeep, void **fkeep); +void slblt_enquire_posdef_s(void *akeep, void *fkeep, struct slblt_control_type_s *control, struct slblt_inform_type_s *inform, float *d); +void slblt_enquire_posdef_s_64(void *akeep, void *fkeep, struct slblt_control_type_s_64 *control, struct slblt_inform_type_s_64 *inform, float *d); +void slblt_enquire_indef_s(void *akeep, void *fkeep, struct slblt_control_type_s *control, struct slblt_inform_type_s *inform, int32_t *piv_order, float *d); +void slblt_enquire_indef_s_64(void *akeep, void *fkeep, struct slblt_control_type_s_64 *control, struct slblt_inform_type_s_64 *inform, int64_t *piv_order, float *d); +void slblt_alter_s(float *d, void *akeep, void *fkeep, struct slblt_control_type_s *control, struct slblt_inform_type_s *inform); +void slblt_alter_s_64(float *d, void *akeep, void *fkeep, struct slblt_control_type_s_64 *control, struct slblt_inform_type_s_64 *inform); // C interface for SLS struct sls_control_type_s { @@ -2553,7 +2537,7 @@ struct sls_inform_type_s { struct ma86_info_s ma86_info; struct ma87_info_s ma87_info; struct ma97_info_s ma97_info; - struct ssids_inform_type_s ssids_inform; + struct slblt_inform_type_s slblt_inform; struct nodend_inform_type_s nodend_inform; int32_t mc61_info[10]; float mc61_rinfo[15]; @@ -2634,7 +2618,7 @@ struct sls_inform_type_s_64 { struct ma86_info_s_64 ma86_info; struct ma87_info_s_64 ma87_info; struct ma97_info_s_64 ma97_info; - struct ssids_inform_type_s_64 ssids_inform; + struct slblt_inform_type_s_64 slblt_inform; struct nodend_inform_type_s_64 nodend_inform; int64_t mc61_info[10]; float mc61_rinfo[15]; diff --git a/include/galahad_cfunctions.h b/include/galahad_cfunctions.h index eb61641a85..fdd825d85b 100644 --- a/include/galahad_cfunctions.h +++ b/include/galahad_cfunctions.h @@ -1,49 +1,3 @@ -#ifdef INTEGER_64 -#ifdef REAL_32 -#define spral_c_dgemm spral_c_sgemm_64 -#define spral_c_dpotrf spral_c_spotrf_64 -#define spral_c_dsytrf spral_c_ssytrf_64 -#define spral_c_dtrsm spral_c_strsm_64 -#define spral_c_dsyrk spral_c_ssyrk_64 -#define spral_c_dtrsv spral_c_strsv_64 -#define spral_c_dgemv spral_c_sgemv_64 -#elif REAL_128 -#define spral_c_dgemm spral_c_qgemm_64 -#define spral_c_dpotrf spral_c_qpotrf_64 -#define spral_c_dsytrf spral_c_qsytrf_64 -#define spral_c_dtrsm spral_c_qtrsm_64 -#define spral_c_dsyrk spral_c_qsyrk_64 -#define spral_c_dtrsv spral_c_qtrsv_64 -#define spral_c_dgemv spral_c_qgemv_64 -#else -#define spral_c_dgemm spral_c_dgemm_64 -#define spral_c_dpotrf spral_c_dpotrf_64 -#define spral_c_dsytrf spral_c_dsytrf_64 -#define spral_c_dtrsm spral_c_dtrsm_64 -#define spral_c_dsyrk spral_c_dsyrk_64 -#define spral_c_dtrsv spral_c_dtrsv_64 -#define spral_c_dgemv spral_c_dgemv_64 -#endif -#else -#ifdef REAL_32 -#define spral_c_dgemm spral_c_sgemm -#define spral_c_dpotrf spral_c_spotrf -#define spral_c_dsytrf spral_c_ssytrf -#define spral_c_dtrsm spral_c_strsm -#define spral_c_dsyrk spral_c_ssyrk -#define spral_c_dtrsv spral_c_strsv -#define spral_c_dgemv spral_c_sgemv -#elif REAL_128 -#define spral_c_dgemm spral_c_qgemm -#define spral_c_dpotrf spral_c_qpotrf -#define spral_c_dsytrf spral_c_qsytrf -#define spral_c_dtrsm spral_c_qtrsm -#define spral_c_dsyrk spral_c_qsyrk -#define spral_c_dtrsv spral_c_qtrsv -#define spral_c_dgemv spral_c_qgemv -#endif -#endif - #ifdef INTEGER_64 #define version_galahad version_galahad_64 #ifdef REAL_32 @@ -420,6 +374,15 @@ #define sllsb_solve_reverse_a_prod sllsb_solve_reverse_a_prod_s_64 #define sllsb_information sllsb_information_s_64 #define sllsb_terminate sllsb_terminate_s_64 +#define sls_initialize sls_initialize_s_64 +#define sls_read_specfile sls_read_specfile_s_64 +#define sls_analyse_matrix sls_analyse_matrix_s_64 +#define sls_reset_control sls_reset_control_s_64 +#define sls_factorize_matrix sls_factorize_matrix_s_64 +#define sls_solve_system sls_solve_system_s_64 +#define sls_partial_solve_system sls_partial_solve_system_s_64 +#define sls_information sls_information_s_64 +#define sls_terminate sls_terminate_s_64 #define snls_initialize snls_initialize_s_64 #define snls_read_specfile snls_read_specfile_s_64 #define snls_import snls_import_s_64 @@ -431,15 +394,6 @@ #define snls_solve_reverse_with_jacprod snls_solve_reverse_with_jacprod_s_64 #define snls_information snls_information_s_64 #define snls_terminate snls_terminate_s_64 -#define sls_initialize sls_initialize_s_64 -#define sls_read_specfile sls_read_specfile_s_64 -#define sls_analyse_matrix sls_analyse_matrix_s_64 -#define sls_reset_control sls_reset_control_s_64 -#define sls_factorize_matrix sls_factorize_matrix_s_64 -#define sls_solve_system sls_solve_system_s_64 -#define sls_partial_solve_system sls_partial_solve_system_s_64 -#define sls_information sls_information_s_64 -#define sls_terminate sls_terminate_s_64 #define ssls_initialize ssls_initialize_s_64 #define ssls_read_specfile ssls_read_specfile_s_64 #define ssls_import ssls_import_s_64 @@ -1056,6 +1010,15 @@ #define sllsb_solve_reverse_a_prod sllsb_solve_reverse_a_prod_q_64 #define sllsb_information sllsb_information_q_64 #define sllsb_terminate sllsb_terminate_q_64 +#define sls_initialize sls_initialize_q_64 +#define sls_read_specfile sls_read_specfile_q_64 +#define sls_analyse_matrix sls_analyse_matrix_q_64 +#define sls_reset_control sls_reset_control_q_64 +#define sls_factorize_matrix sls_factorize_matrix_q_64 +#define sls_solve_system sls_solve_system_q_64 +#define sls_partial_solve_system sls_partial_solve_system_q_64 +#define sls_information sls_information_q_64 +#define sls_terminate sls_terminate_q_64 #define snls_initialize snls_initialize_q_64 #define snls_read_specfile snls_read_specfile_q_64 #define snls_import snls_import_q_64 @@ -1067,15 +1030,6 @@ #define snls_solve_reverse_with_jacprod snls_solve_reverse_with_jacprod_q_64 #define snls_information snls_information_q_64 #define snls_terminate snls_terminate_q_64 -#define sls_initialize sls_initialize_q_64 -#define sls_read_specfile sls_read_specfile_q_64 -#define sls_analyse_matrix sls_analyse_matrix_q_64 -#define sls_reset_control sls_reset_control_q_64 -#define sls_factorize_matrix sls_factorize_matrix_q_64 -#define sls_solve_system sls_solve_system_q_64 -#define sls_partial_solve_system sls_partial_solve_system_q_64 -#define sls_information sls_information_q_64 -#define sls_terminate sls_terminate_q_64 #define ssls_initialize ssls_initialize_q_64 #define ssls_read_specfile ssls_read_specfile_q_64 #define ssls_import ssls_import_q_64 @@ -1288,12 +1242,12 @@ #define sllsb_control_type sllsb_control_type_q_64 #define sllsb_inform_type sllsb_inform_type_q_64 #define sllsb_time_type sllsb_time_type_q_64 -#define snls_control_type snls_control_type_q_64 -#define snls_inform_type snls_inform_type_q_64 -#define snls_time_type snls_time_type_q_64 #define sls_control_type sls_control_type_q_64 #define sls_inform_type sls_inform_type_q_64 #define sls_time_type sls_time_type_q_64 +#define snls_control_type snls_control_type_q_64 +#define snls_inform_type snls_inform_type_q_64 +#define snls_time_type snls_time_type_q_64 #define ssls_control_type ssls_control_type_q_64 #define ssls_inform_type ssls_inform_type_q_64 #define ssls_time_type ssls_time_type_q_64 @@ -1692,6 +1646,15 @@ #define sllsb_solve_reverse_a_prod sllsb_solve_reverse_a_prod_64 #define sllsb_information sllsb_information_64 #define sllsb_terminate sllsb_terminate_64 +#define sls_initialize sls_initialize_64 +#define sls_read_specfile sls_read_specfile_64 +#define sls_analyse_matrix sls_analyse_matrix_64 +#define sls_reset_control sls_reset_control_64 +#define sls_factorize_matrix sls_factorize_matrix_64 +#define sls_solve_system sls_solve_system_64 +#define sls_partial_solve_system sls_partial_solve_system_64 +#define sls_information sls_information_64 +#define sls_terminate sls_terminate_64 #define snls_initialize snls_initialize_64 #define snls_read_specfile snls_read_specfile_64 #define snls_import snls_import_64 @@ -1703,15 +1666,6 @@ #define snls_solve_reverse_with_jacprod snls_solve_reverse_with_jacprod_64 #define snls_information snls_information_64 #define snls_terminate snls_terminate_64 -#define sls_initialize sls_initialize_64 -#define sls_read_specfile sls_read_specfile_64 -#define sls_analyse_matrix sls_analyse_matrix_64 -#define sls_reset_control sls_reset_control_64 -#define sls_factorize_matrix sls_factorize_matrix_64 -#define sls_solve_system sls_solve_system_64 -#define sls_partial_solve_system sls_partial_solve_system_64 -#define sls_information sls_information_64 -#define sls_terminate sls_terminate_64 #define ssls_initialize ssls_initialize_64 #define ssls_read_specfile ssls_read_specfile_64 #define ssls_import ssls_import_64 @@ -1924,12 +1878,12 @@ #define sllsb_control_type sllsb_control_type_64 #define sllsb_inform_type sllsb_inform_type_64 #define sllsb_time_type sllsb_time_type_64 -#define snls_control_type snls_control_type_64 -#define snls_inform_type snls_inform_type_64 -#define snls_time_type snls_time_type_64 #define sls_control_type sls_control_type_64 #define sls_inform_type sls_inform_type_64 #define sls_time_type sls_time_type_64 +#define snls_control_type snls_control_type_64 +#define snls_inform_type snls_inform_type_64 +#define snls_time_type snls_time_type_64 #define ssls_control_type ssls_control_type_64 #define ssls_inform_type ssls_inform_type_64 #define ssls_time_type ssls_time_type_64 @@ -2330,6 +2284,15 @@ #define sllsb_solve_reverse_a_prod sllsb_solve_reverse_a_prod_s #define sllsb_information sllsb_information_s #define sllsb_terminate sllsb_terminate_s +#define sls_initialize sls_initialize_s +#define sls_read_specfile sls_read_specfile_s +#define sls_analyse_matrix sls_analyse_matrix_s +#define sls_reset_control sls_reset_control_s +#define sls_factorize_matrix sls_factorize_matrix_s +#define sls_solve_system sls_solve_system_s +#define sls_partial_solve_system sls_partial_solve_system_s +#define sls_information sls_information_s +#define sls_terminate sls_terminate_s #define snls_initialize snls_initialize_s #define snls_read_specfile snls_read_specfile_s #define snls_import snls_import_s @@ -2341,15 +2304,6 @@ #define snls_solve_reverse_with_jacprod snls_solve_reverse_with_jacprod_s #define snls_information snls_information_s #define snls_terminate snls_terminate_s -#define sls_initialize sls_initialize_s -#define sls_read_specfile sls_read_specfile_s -#define sls_analyse_matrix sls_analyse_matrix_s -#define sls_reset_control sls_reset_control_s -#define sls_factorize_matrix sls_factorize_matrix_s -#define sls_solve_system sls_solve_system_s -#define sls_partial_solve_system sls_partial_solve_system_s -#define sls_information sls_information_s -#define sls_terminate sls_terminate_s #define ssls_initialize ssls_initialize_s #define ssls_read_specfile ssls_read_specfile_s #define ssls_import ssls_import_s @@ -2562,12 +2516,12 @@ #define sllsb_control_type sllsb_control_type_s #define sllsb_inform_type sllsb_inform_type_s #define sllsb_time_type sllsb_time_type_s -#define snls_control_type snls_control_type_s -#define snls_inform_type snls_inform_type_s -#define snls_time_type snls_time_type_s #define sls_control_type sls_control_type_s #define sls_inform_type sls_inform_type_s #define sls_time_type sls_time_type_s +#define snls_control_type snls_control_type_s +#define snls_inform_type snls_inform_type_s +#define snls_time_type snls_time_type_s #define ssls_control_type ssls_control_type_s #define ssls_inform_type ssls_inform_type_s #define ssls_time_type ssls_time_type_s @@ -2966,6 +2920,15 @@ #define sllsb_solve_reverse_a_prod sllsb_solve_reverse_a_prod_q #define sllsb_information sllsb_information_q #define sllsb_terminate sllsb_terminate_q +#define sls_initialize sls_initialize_q +#define sls_read_specfile sls_read_specfile_q +#define sls_analyse_matrix sls_analyse_matrix_q +#define sls_reset_control sls_reset_control_q +#define sls_factorize_matrix sls_factorize_matrix_q +#define sls_solve_system sls_solve_system_q +#define sls_partial_solve_system sls_partial_solve_system_q +#define sls_information sls_information_q +#define sls_terminate sls_terminate_q #define snls_initialize snls_initialize_q #define snls_read_specfile snls_read_specfile_q #define snls_import snls_import_q @@ -2977,15 +2940,6 @@ #define snls_solve_reverse_with_jacprod snls_solve_reverse_with_jacprod_q #define snls_information snls_information_q #define snls_terminate snls_terminate_q -#define sls_initialize sls_initialize_q -#define sls_read_specfile sls_read_specfile_q -#define sls_analyse_matrix sls_analyse_matrix_q -#define sls_reset_control sls_reset_control_q -#define sls_factorize_matrix sls_factorize_matrix_q -#define sls_solve_system sls_solve_system_q -#define sls_partial_solve_system sls_partial_solve_system_q -#define sls_information sls_information_q -#define sls_terminate sls_terminate_q #define ssls_initialize ssls_initialize_q #define ssls_read_specfile ssls_read_specfile_q #define ssls_import ssls_import_q @@ -3198,12 +3152,12 @@ #define sllsb_control_type sllsb_control_type_q #define sllsb_inform_type sllsb_inform_type_q #define sllsb_time_type sllsb_time_type_q -#define snls_control_type snls_control_type_q -#define snls_inform_type snls_inform_type_q -#define snls_time_type snls_time_type_q #define sls_control_type sls_control_type_q #define sls_inform_type sls_inform_type_q #define sls_time_type sls_time_type_q +#define snls_control_type snls_control_type_q +#define snls_inform_type snls_inform_type_q +#define snls_time_type snls_time_type_q #define ssls_control_type ssls_control_type_q #define ssls_inform_type ssls_inform_type_q #define ssls_time_type ssls_time_type_q @@ -3339,91 +3293,91 @@ #ifdef INTEGER_64 #ifdef REAL_32 -#define ssids_default_control ssids_default_control_s_64 -#define ssids_analyse ssids_analyse_s_64 -#define ssids_analyse_ptr32 ssids_analyse_ptr32_s_64 -#define ssids_analyse_coord ssids_analyse_coord_s_64 -#define ssids_factor ssids_factor_s_64 -#define ssids_factor_ptr32 ssids_factor_ptr32_s_64 -#define ssids_solve1 ssids_solve1_s_64 -#define ssids_solve ssids_solve_s_64 -#define ssids_free_akeep ssids_free_akeep_s_64 -#define ssids_free_fkeep ssids_free_fkeep_s_64 -#define ssids_free ssids_free_s_64 -#define ssids_enquire_posdef ssids_enquire_posdef_s_64 -#define ssids_enquire_indef ssids_enquire_indef_s_64 -#define ssids_alter ssids_alter_s_64 -#define ssids_control_type ssids_control_type_s_64 -#define ssids_inform_type ssids_inform_type_s_64 +#define slblt_default_control slblt_default_control_s_64 +#define slblt_analyse slblt_analyse_s_64 +#define slblt_analyse_ptr32 slblt_analyse_ptr32_s_64 +#define slblt_analyse_coord slblt_analyse_coord_s_64 +#define slblt_factor slblt_factor_s_64 +#define slblt_factor_ptr32 slblt_factor_ptr32_s_64 +#define slblt_solve1 slblt_solve1_s_64 +#define slblt_solve slblt_solve_s_64 +#define slblt_free_akeep slblt_free_akeep_s_64 +#define slblt_free_fkeep slblt_free_fkeep_s_64 +#define slblt_free slblt_free_s_64 +#define slblt_enquire_posdef slblt_enquire_posdef_s_64 +#define slblt_enquire_indef slblt_enquire_indef_s_64 +#define slblt_alter slblt_alter_s_64 +#define slblt_control_type slblt_control_type_s_64 +#define slblt_inform_type slblt_inform_type_s_64 #elif REAL_128 -#define ssids_default_control ssids_default_control_q_64 -#define ssids_analyse ssids_analyse_q_64 -#define ssids_analyse_ptr32 ssids_analyse_ptr32_q_64 -#define ssids_analyse_coord ssids_analyse_coord_q_64 -#define ssids_factor ssids_factor_q_64 -#define ssids_factor_ptr32 ssids_factor_ptr32_q_64 -#define ssids_solve1 ssids_solve1_q_64 -#define ssids_solve ssids_solve_q_64 -#define ssids_free_akeep ssids_free_akeep_q_64 -#define ssids_free_fkeep ssids_free_fkeep_q_64 -#define ssids_free ssids_free_q_64 -#define ssids_enquire_posdef ssids_enquire_posdef_q_64 -#define ssids_enquire_indef ssids_enquire_indef_q_64 -#define ssids_alter ssids_alter_q_64 -#define ssids_control_type ssids_control_type_q_64 -#define ssids_inform_type ssids_inform_type_q_64 +#define slblt_default_control slblt_default_control_q_64 +#define slblt_analyse slblt_analyse_q_64 +#define slblt_analyse_ptr32 slblt_analyse_ptr32_q_64 +#define slblt_analyse_coord slblt_analyse_coord_q_64 +#define slblt_factor slblt_factor_q_64 +#define slblt_factor_ptr32 slblt_factor_ptr32_q_64 +#define slblt_solve1 slblt_solve1_q_64 +#define slblt_solve slblt_solve_q_64 +#define slblt_free_akeep slblt_free_akeep_q_64 +#define slblt_free_fkeep slblt_free_fkeep_q_64 +#define slblt_free slblt_free_q_64 +#define slblt_enquire_posdef slblt_enquire_posdef_q_64 +#define slblt_enquire_indef slblt_enquire_indef_q_64 +#define slblt_alter slblt_alter_q_64 +#define slblt_control_type slblt_control_type_q_64 +#define slblt_inform_type slblt_inform_type_q_64 #else -#define ssids_default_control ssids_default_control_64 -#define ssids_analyse ssids_analyse_64 -#define ssids_analyse_ptr32 ssids_analyse_ptr32_64 -#define ssids_analyse_coord ssids_analyse_coord_64 -#define ssids_factor ssids_factor_64 -#define ssids_factor_ptr32 ssids_factor_ptr32_64 -#define ssids_solve1 ssids_solve1_64 -#define ssids_solve ssids_solve_64 -#define ssids_free_akeep ssids_free_akeep_64 -#define ssids_free_fkeep ssids_free_fkeep_64 -#define ssids_free ssids_free_64 -#define ssids_enquire_posdef ssids_enquire_posdef_64 -#define ssids_enquire_indef ssids_enquire_indef_64 -#define ssids_alter ssids_alter_64 -#define ssids_control_type ssids_control_type_64 -#define ssids_inform_type ssids_inform_type_64 +#define slblt_default_control slblt_default_control_64 +#define slblt_analyse slblt_analyse_64 +#define slblt_analyse_ptr32 slblt_analyse_ptr32_64 +#define slblt_analyse_coord slblt_analyse_coord_64 +#define slblt_factor slblt_factor_64 +#define slblt_factor_ptr32 slblt_factor_ptr32_64 +#define slblt_solve1 slblt_solve1_64 +#define slblt_solve slblt_solve_64 +#define slblt_free_akeep slblt_free_akeep_64 +#define slblt_free_fkeep slblt_free_fkeep_64 +#define slblt_free slblt_free_64 +#define slblt_enquire_posdef slblt_enquire_posdef_64 +#define slblt_enquire_indef slblt_enquire_indef_64 +#define slblt_alter slblt_alter_64 +#define slblt_control_type slblt_control_type_64 +#define slblt_inform_type slblt_inform_type_64 #endif #else #ifdef REAL_32 -#define ssids_default_control ssids_default_control_s -#define ssids_analyse ssids_analyse_s -#define ssids_analyse_ptr32 ssids_analyse_ptr32_s -#define ssids_analyse_coord ssids_analyse_coord_s -#define ssids_factor ssids_factor_s -#define ssids_factor_ptr32 ssids_factor_ptr32_s -#define ssids_solve1 ssids_solve1_s -#define ssids_solve ssids_solve_s -#define ssids_free_akeep ssids_free_akeep_s -#define ssids_free_fkeep ssids_free_fkeep_s -#define ssids_free ssids_free_s -#define ssids_enquire_posdef ssids_enquire_posdef_s -#define ssids_enquire_indef ssids_enquire_indef_s -#define ssids_alter ssids_alter_s -#define ssids_control_type ssids_control_type_s -#define ssids_inform_type ssids_inform_type_s +#define slblt_default_control slblt_default_control_s +#define slblt_analyse slblt_analyse_s +#define slblt_analyse_ptr32 slblt_analyse_ptr32_s +#define slblt_analyse_coord slblt_analyse_coord_s +#define slblt_factor slblt_factor_s +#define slblt_factor_ptr32 slblt_factor_ptr32_s +#define slblt_solve1 slblt_solve1_s +#define slblt_solve slblt_solve_s +#define slblt_free_akeep slblt_free_akeep_s +#define slblt_free_fkeep slblt_free_fkeep_s +#define slblt_free slblt_free_s +#define slblt_enquire_posdef slblt_enquire_posdef_s +#define slblt_enquire_indef slblt_enquire_indef_s +#define slblt_alter slblt_alter_s +#define slblt_control_type slblt_control_type_s +#define slblt_inform_type slblt_inform_type_s #elif REAL_128 -#define ssids_default_control ssids_default_control_q -#define ssids_analyse ssids_analyse_q -#define ssids_analyse_ptr32 ssids_analyse_ptr32_q -#define ssids_analyse_coord ssids_analyse_coord_q -#define ssids_factor ssids_factor_q -#define ssids_factor_ptr32 ssids_factor_ptr32_q -#define ssids_solve1 ssids_solve1_q -#define ssids_solve ssids_solve_q -#define ssids_free_akeep ssids_free_akeep_q -#define ssids_free_fkeep ssids_free_fkeep_q -#define ssids_free ssids_free_q -#define ssids_enquire_posdef ssids_enquire_posdef_q -#define ssids_enquire_indef ssids_enquire_indef_q -#define ssids_alter ssids_alter_q -#define ssids_control_type ssids_control_type_q -#define ssids_inform_type galahad_ssids_inform_type_q +#define slblt_default_control slblt_default_control_q +#define slblt_analyse slblt_analyse_q +#define slblt_analyse_ptr32 slblt_analyse_ptr32_q +#define slblt_analyse_coord slblt_analyse_coord_q +#define slblt_factor slblt_factor_q +#define slblt_factor_ptr32 slblt_factor_ptr32_q +#define slblt_solve1 slblt_solve1_q +#define slblt_solve slblt_solve_q +#define slblt_free_akeep slblt_free_akeep_q +#define slblt_free_fkeep slblt_free_fkeep_q +#define slblt_free slblt_free_q +#define slblt_enquire_posdef slblt_enquire_posdef_q +#define slblt_enquire_indef slblt_enquire_indef_q +#define slblt_alter slblt_alter_q +#define slblt_control_type slblt_control_type_q +#define slblt_inform_type galahad_slblt_inform_type_q #endif #endif diff --git a/include/galahad_guess_topology.hxx b/include/galahad_guess_topology.hxx deleted file mode 100644 index 1f392af15a..0000000000 --- a/include/galahad_guess_topology.hxx +++ /dev/null @@ -1,27 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-25 AT 11:40 GMT - * - * \brief - * Defines NumaRegion struct. - */ -#pragma once - -namespace galahad { -/** \brief Hardware topology module */ -namespace hw_topology { - -struct NumaRegion { - int nproc; - int ngpu; - int *gpus; -}; - -extern "C" -void galahad_hw_topology_guess(int* nregions, NumaRegion** regions); -extern "C" -void galahad_hw_topology_free(int nregions, NumaRegion* regions); - -}} /* namespace galahad::hw_topology */ diff --git a/include/galahad_hwloc_wrapper.hxx b/include/galahad_hwloc_wrapper.hxx deleted file mode 100644 index 5066752192..0000000000 --- a/include/galahad_hwloc_wrapper.hxx +++ /dev/null @@ -1,121 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 09:00 GMT - * - * \brief - * Implements HwlocTopology wrapper around hwloc library - */ -#pragma once -#include "ssids_config.h" - -#ifdef HAVE_HWLOC -#include -#include - -#ifdef HAVE_NVCC -#include -#include -#endif /* HAVE_NVCC */ - -namespace galahad { namespace hw_topology { - -/** - * \brief Object orientated wrapper around hwloc topology. - */ -class HwlocTopology { -public: - // \{ - // Not copyable - HwlocTopology(HwlocTopology const&) =delete; - HwlocTopology operator=(HwlocTopology const&) =delete; - // \} - /** \brief Constructor */ - HwlocTopology() { - hwloc_topology_init(&topology_); -#ifdef HAVE_NVCC -#if HWLOC_API_VERSION >= 0x20000 - hwloc_topology_set_type_filter(topology_, HWLOC_OBJ_OS_DEVICE, - HWLOC_TYPE_FILTER_KEEP_IMPORTANT); - hwloc_topology_set_type_filter(topology_, HWLOC_OBJ_PCI_DEVICE, - HWLOC_TYPE_FILTER_KEEP_IMPORTANT); -#else /* HWLOC_API_VERSION */ - hwloc_topology_set_flags(topology_, HWLOC_TOPOLOGY_FLAG_IO_DEVICES); -#endif /* HWLOC_API_VERSION */ -#endif /* HAVE_NVCC */ - hwloc_topology_load(topology_); - } - /** \brief Destructor */ - ~HwlocTopology() { - hwloc_topology_destroy(topology_); - } - - /** \brief Return vector of Numa nodes or just machine object */ - std::vector get_numa_nodes() const { - std::vector regions; - int nregions = hwloc_get_nbobjs_by_type(topology_, HWLOC_OBJ_NODE); - if(nregions==0) { - // No regions, just give machine - regions.push_back( - hwloc_get_obj_by_type(topology_, HWLOC_OBJ_MACHINE, 0) - ); - return regions; - } else { - // Iterate over regions, adding them - regions.reserve(nregions); - for(int i=0; i get_gpus(hwloc_obj_t const& obj) const { - std::vector gpus; -#ifdef HAVE_NVCC - int ngpu; - cudaError_t cuda_error = cudaGetDeviceCount(&ngpu); - if(cuda_error != cudaSuccess) { - //printf("Error using CUDA. Assuming no GPUs.\n"); - return gpus; // empty - } - /* Now for each device search up its topology tree and see if we - * encounter obj. */ - for(int i=0; iparent) { - if(p==obj) { - gpus.push_back(i); - break; - } - } - } -#endif - return gpus; // will be empty ifndef HAVE_NVCC - } - -private: - int count_type(hwloc_obj_t const& obj, hwloc_obj_type_t type) const { - if(obj->type == type) return 1; - int count = 0; - for(unsigned int i=0; iarity; ++i) - count += count_type(obj->children[i], type); - return count; - } - - hwloc_topology_t topology_; ///< Underlying topology object -}; - -}} /* namespace galahad::hw_topology */ - -#endif /* HAVE_HWLOC */ diff --git a/include/galahad_modules.h b/include/galahad_modules.h index 52166258c6..2ec88f95e4 100644 --- a/include/galahad_modules.h +++ b/include/galahad_modules.h @@ -7,7 +7,7 @@ #define GALAHAD_METIS GALAHAD_METIS_64 #define GALAHAD_HASH GALAHAD_HASH_64 #define GALAHAD_HASH_ciface GALAHAD_HASH_ciface_64 -#define GALAHAD_HW GALAHAD_HW_64 +#define GALAHAD_TOPOLOGY GALAHAD_TOPOLOGY_64 #define GALAHAD_STRING GALAHAD_STRING_64 #define GALAHAD_SYMBOLS GALAHAD_SYMBOLS_64 #define GALAHAD_COPYRIGHT GALAHAD_COPYRIGHT_64 diff --git a/include/galahad_modules_double.h b/include/galahad_modules_double.h index 6a5ba529f0..e9a56abc0f 100644 --- a/include/galahad_modules_double.h +++ b/include/galahad_modules_double.h @@ -134,26 +134,19 @@ #endif #define GALAHAD_SLLS_precision GALAHAD_SLLS_double_64 #define GALAHAD_SLLSB_precision GALAHAD_SLLSB_double_64 -#define GALAHAD_SNLS_precision GALAHAD_SNLS_double_64 #define GALAHAD_SLS_precision GALAHAD_SLS_double_64 +#define GALAHAD_SNLS_precision GALAHAD_SNLS_double_64 #define GALAHAD_SMT_precision GALAHAD_SMT_double_64 #define GALAHAD_SORT_precision GALAHAD_SORT_double_64 #define GALAHAD_SPACE_precision GALAHAD_SPACE_double_64 #define GALAHAD_SPECFILE_precision GALAHAD_SPECFILE_double_64 -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_double_64 -#define GALAHAD_SSIDS_akeep_precision GALAHAD_SSIDS_akeep_double_64 -#define GALAHAD_SSIDS_analyse_precision GALAHAD_SSIDS_analyse_double_64 -#define GALAHAD_SSIDS_contrib_free_precision GALAHAD_SSIDS_contrib_free_dbl_64 -#define GALAHAD_SSIDS_contrib_fsub_precision GALAHAD_SSIDS_contrib_fsub_double_64 -#define GALAHAD_SSIDS_contrib_precision GALAHAD_SSIDS_contrib_double_64 -#define GALAHAD_SSIDS_contrib_get_data_precision GALAHAD_SSIDS_contrib_get_data_double_64 -#define GALAHAD_SSIDS_cpu_iface_precision GALAHAD_SSIDS_cpu_iface_double_64 -#define GALAHAD_SSIDS_cpu_subtree_precision GALAHAD_SSIDS_cpu_subtree_double_64 -#define GALAHAD_SSIDS_fkeep_precision GALAHAD_SSIDS_fkeep_double_64 -#define GALAHAD_SSIDS_gpu_subtree_precision GALAHAD_SSIDS_gpu_subtree_double_64 -#define GALAHAD_SSIDS_inform_precision GALAHAD_SSIDS_inform_double_64 -#define GALAHAD_SSIDS_subtree_precision GALAHAD_SSIDS_subtree_double_64 -#define GALAHAD_SSIDS_types_precision GALAHAD_SSIDS_types_double_64 +#define GALAHAD_SLBLT_precision GALAHAD_SLBLT_double_64 +#define GALAHAD_SLBLT_contrib_free_precision GALAHAD_SLBLT_contrib_free_dbl_64 +#define GALAHAD_SLBLT_contrib_get_data_precision GALAHAD_SLBLT_contrib_get_data_double_64 +#define GALAHAD_SLBLT_numeric_subtree_precision GALAHAD_SLBLT_numeric_subtree_double_64 +#define GALAHAD_SLBLT_factor_precision GALAHAD_SLBLT_factor_double_64 +#define GALAHAD_SLBLT_subtree_precision GALAHAD_SLBLT_subtree_double_64 +#define GALAHAD_SLBLT_types_precision GALAHAD_SLBLT_types_double_64 #define GALAHAD_SUPERB_precision GALAHAD_SUPERB_double_64 #define GALAHAD_SVT_precision GALAHAD_SVT_double_64 #define GALAHAD_TRACE_precision GALAHAD_TRACE_double_64 @@ -331,9 +324,9 @@ #endif #define GALAHAD_SLLS_precision_ciface GALAHAD_SLLS_double_ciface_64 #define GALAHAD_SLLSB_precision_ciface GALAHAD_SLLSB_double_ciface_64 -#define GALAHAD_SNLS_precision_ciface GALAHAD_SNLS_double_ciface_64 #define GALAHAD_SLS_precision_ciface GALAHAD_SLS_double_ciface_64 -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_double_ciface_64 +#define GALAHAD_SNLS_precision_ciface GALAHAD_SNLS_double_ciface_64 +#define GALAHAD_SLBLT_precision_ciface GALAHAD_SLBLT_double_ciface_64 #define GALAHAD_TRB_precision_ciface GALAHAD_TRB_double_ciface_64 #define GALAHAD_TREK_precision_ciface GALAHAD_TREK_double_ciface_64 #define GALAHAD_TRS_precision_ciface GALAHAD_TRS_double_ciface_64 @@ -579,26 +572,19 @@ #endif #define GALAHAD_SLLS_precision GALAHAD_SLLS_double #define GALAHAD_SLLSB_precision GALAHAD_SLLSB_double -#define GALAHAD_SNLS_precision GALAHAD_SNLS_double #define GALAHAD_SLS_precision GALAHAD_SLS_double +#define GALAHAD_SNLS_precision GALAHAD_SNLS_double #define GALAHAD_SMT_precision GALAHAD_SMT_double #define GALAHAD_SORT_precision GALAHAD_SORT_double #define GALAHAD_SPACE_precision GALAHAD_SPACE_double #define GALAHAD_SPECFILE_precision GALAHAD_SPECFILE_double -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_double -#define GALAHAD_SSIDS_akeep_precision GALAHAD_SSIDS_akeep_double -#define GALAHAD_SSIDS_analyse_precision GALAHAD_SSIDS_analyse_double -#define GALAHAD_SSIDS_contrib_free_precision GALAHAD_SSIDS_contrib_free_dbl -#define GALAHAD_SSIDS_contrib_fsub_precision GALAHAD_SSIDS_contrib_fsub_double -#define GALAHAD_SSIDS_contrib_precision GALAHAD_SSIDS_contrib_double -#define GALAHAD_SSIDS_contrib_get_data_precision GALAHAD_SSIDS_contrib_get_data_double -#define GALAHAD_SSIDS_cpu_iface_precision GALAHAD_SSIDS_cpu_iface_double -#define GALAHAD_SSIDS_cpu_subtree_precision GALAHAD_SSIDS_cpu_subtree_double -#define GALAHAD_SSIDS_fkeep_precision GALAHAD_SSIDS_fkeep_double -#define GALAHAD_SSIDS_gpu_subtree_precision GALAHAD_SSIDS_gpu_subtree_double -#define GALAHAD_SSIDS_inform_precision GALAHAD_SSIDS_inform_double -#define GALAHAD_SSIDS_subtree_precision GALAHAD_SSIDS_subtree_double -#define GALAHAD_SSIDS_types_precision GALAHAD_SSIDS_types_double +#define GALAHAD_SLBLT_precision GALAHAD_SLBLT_double +#define GALAHAD_SLBLT_contrib_free_precision GALAHAD_SLBLT_contrib_free_dbl +#define GALAHAD_SLBLT_contrib_get_data_precision GALAHAD_SLBLT_contrib_get_data_double +#define GALAHAD_SLBLT_numeric_subtree_precision GALAHAD_SLBLT_numeric_subtree_double +#define GALAHAD_SLBLT_factor_precision GALAHAD_SLBLT_factor_double +#define GALAHAD_SLBLT_subtree_precision GALAHAD_SLBLT_subtree_double +#define GALAHAD_SLBLT_types_precision GALAHAD_SLBLT_types_double #define GALAHAD_SUPERB_precision GALAHAD_SUPERB_double #define GALAHAD_SVT_precision GALAHAD_SVT_double #define GALAHAD_TRACE_precision GALAHAD_TRACE_double @@ -776,9 +762,9 @@ #endif #define GALAHAD_SLLS_precision_ciface GALAHAD_SLLS_double_ciface #define GALAHAD_SLLSB_precision_ciface GALAHAD_SLLSB_double_ciface -#define GALAHAD_SNLS_precision_ciface GALAHAD_SNLS_double_ciface #define GALAHAD_SLS_precision_ciface GALAHAD_SLS_double_ciface -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_double_ciface +#define GALAHAD_SNLS_precision_ciface GALAHAD_SNLS_double_ciface +#define GALAHAD_SLBLT_precision_ciface GALAHAD_SLBLT_double_ciface #define GALAHAD_TRB_precision_ciface GALAHAD_TRB_double_ciface #define GALAHAD_TREK_precision_ciface GALAHAD_TREK_double_ciface #define GALAHAD_TRS_precision_ciface GALAHAD_TRS_double_ciface diff --git a/include/galahad_modules_quadruple.h b/include/galahad_modules_quadruple.h index 6a0004ab60..82a9882036 100644 --- a/include/galahad_modules_quadruple.h +++ b/include/galahad_modules_quadruple.h @@ -133,26 +133,19 @@ #endif #define GALAHAD_SLLS_precision GALAHAD_SLLS_quadruple_64 #define GALAHAD_SLLSB_precision GALAHAD_SLLSB_quadruple_64 -#define GALAHAD_SNLS_precision GALAHAD_SNLS_quadruple_64 #define GALAHAD_SLS_precision GALAHAD_SLS_quadruple_64 +#define GALAHAD_SNLS_precision GALAHAD_SNLS_quadruple_64 #define GALAHAD_SMT_precision GALAHAD_SMT_quadruple_64 #define GALAHAD_SORT_precision GALAHAD_SORT_quadruple_64 #define GALAHAD_SPACE_precision GALAHAD_SPACE_quadruple_64 #define GALAHAD_SPECFILE_precision GALAHAD_SPECFILE_quadruple_64 -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_quadruple_64 -#define GALAHAD_SSIDS_akeep_precision GALAHAD_SSIDS_akeep_quadruple_64 -#define GALAHAD_SSIDS_analyse_precision GALAHAD_SSIDS_analyse_quadruple_64 -#define GALAHAD_SSIDS_contrib_free_precision GALAHAD_SSIDS_contrib_free_qul_64 -#define GALAHAD_SSIDS_contrib_fsub_precision GALAHAD_SSIDS_contrib_fsub_quadruple_64 -#define GALAHAD_SSIDS_contrib_precision GALAHAD_SSIDS_contrib_quadruple_64 -#define GALAHAD_SSIDS_contrib_get_data_precision GALAHAD_SSIDS_contrib_get_data_quadruple_64 -#define GALAHAD_SSIDS_cpu_iface_precision GALAHAD_SSIDS_cpu_iface_quadruple_64 -#define GALAHAD_SSIDS_cpu_subtree_precision GALAHAD_SSIDS_cpu_subtree_quadruple_64 -#define GALAHAD_SSIDS_fkeep_precision GALAHAD_SSIDS_fkeep_quadruple_64 -#define GALAHAD_SSIDS_gpu_subtree_precision GALAHAD_SSIDS_gpu_subtree_quadruple_64 -#define GALAHAD_SSIDS_inform_precision GALAHAD_SSIDS_inform_quadruple_64 -#define GALAHAD_SSIDS_subtree_precision GALAHAD_SSIDS_subtree_quadruple_64 -#define GALAHAD_SSIDS_types_precision GALAHAD_SSIDS_types_quadruple_64 +#define GALAHAD_SLBLT_precision GALAHAD_SLBLT_quadruple_64 +#define GALAHAD_SLBLT_contrib_free_precision GALAHAD_SLBLT_contrib_free_qul_64 +#define GALAHAD_SLBLT_contrib_get_data_precision GALAHAD_SLBLT_contrib_get_data_quadruple_64 +#define GALAHAD_SLBLT_numeric_subtree_precision GALAHAD_SLBLT_numeric_subtree_quadruple_64 +#define GALAHAD_SLBLT_factor_precision GALAHAD_SLBLT_factor_quadruple_64 +#define GALAHAD_SLBLT_subtree_precision GALAHAD_SLBLT_subtree_quadruple_64 +#define GALAHAD_SLBLT_types_precision GALAHAD_SLBLT_types_quadruple_64 #define GALAHAD_SUPERB_precision GALAHAD_SUPERB_quadruple_64 #define GALAHAD_SVT_precision GALAHAD_SVT_quadruple_64 #define GALAHAD_TRACE_precision GALAHAD_TRACE_quadruple_64 @@ -331,7 +324,7 @@ #define GALAHAD_SLLS_precision_ciface GALAHAD_SLLS_quadruple_ciface_64 #define GALAHAD_SLLSB_precision_ciface GALAHAD_SLLSB_quadruple_ciface_64 #define GALAHAD_SNLS_precision_ciface GALAHAD_SNLS_quadruple_ciface_64 -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_quadruple_ciface_64 +#define GALAHAD_SLBLT_precision_ciface GALAHAD_SLBLT_quadruple_ciface_64 #define GALAHAD_SLS_precision_ciface GALAHAD_SLS_quadruple_ciface_64 #define GALAHAD_TRB_precision_ciface GALAHAD_TRB_quadruple_ciface_64 #define GALAHAD_TREK_precision_ciface GALAHAD_TREK_quadruple_ciface_64 @@ -578,26 +571,19 @@ #endif #define GALAHAD_SLLS_precision GALAHAD_SLLS_quadruple #define GALAHAD_SLLSB_precision GALAHAD_SLLSB_quadruple -#define GALAHAD_SNLS_precision GALAHAD_SNLS_quadruple #define GALAHAD_SLS_precision GALAHAD_SLS_quadruple +#define GALAHAD_SNLS_precision GALAHAD_SNLS_quadruple #define GALAHAD_SMT_precision GALAHAD_SMT_quadruple #define GALAHAD_SORT_precision GALAHAD_SORT_quadruple #define GALAHAD_SPACE_precision GALAHAD_SPACE_quadruple #define GALAHAD_SPECFILE_precision GALAHAD_SPECFILE_quadruple -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_quadruple -#define GALAHAD_SSIDS_akeep_precision GALAHAD_SSIDS_akeep_quadruple -#define GALAHAD_SSIDS_analyse_precision GALAHAD_SSIDS_analyse_quadruple -#define GALAHAD_SSIDS_contrib_free_precision GALAHAD_SSIDS_contrib_free_qul -#define GALAHAD_SSIDS_contrib_fsub_precision GALAHAD_SSIDS_contrib_fsub_quadruple -#define GALAHAD_SSIDS_contrib_precision GALAHAD_SSIDS_contrib_quadruple -#define GALAHAD_SSIDS_contrib_get_data_precision GALAHAD_SSIDS_contrib_get_data_quadruple -#define GALAHAD_SSIDS_cpu_iface_precision GALAHAD_SSIDS_cpu_iface_quadruple -#define GALAHAD_SSIDS_cpu_subtree_precision GALAHAD_SSIDS_cpu_subtree_quadruple -#define GALAHAD_SSIDS_fkeep_precision GALAHAD_SSIDS_fkeep_quadruple -#define GALAHAD_SSIDS_gpu_subtree_precision GALAHAD_SSIDS_gpu_subtree_quadruple -#define GALAHAD_SSIDS_inform_precision GALAHAD_SSIDS_inform_quadruple -#define GALAHAD_SSIDS_subtree_precision GALAHAD_SSIDS_subtree_quadruple -#define GALAHAD_SSIDS_types_precision GALAHAD_SSIDS_types_quadruple +#define GALAHAD_SLBLT_precision GALAHAD_SLBLT_quadruple +#define GALAHAD_SLBLT_contrib_free_precision GALAHAD_SLBLT_contrib_free_qul +#define GALAHAD_SLBLT_contrib_get_data_precision GALAHAD_SLBLT_contrib_get_data_quadruple +#define GALAHAD_SLBLT_numeric_subtree_precision GALAHAD_SLBLT_numeric_subtree_quadruple +#define GALAHAD_SLBLT_factor_precision GALAHAD_SLBLT_factor_quadruple +#define GALAHAD_SLBLT_subtree_precision GALAHAD_SLBLT_subtree_quadruple +#define GALAHAD_SLBLT_types_precision GALAHAD_SLBLT_types_quadruple #define GALAHAD_SUPERB_precision GALAHAD_SUPERB_quadruple #define GALAHAD_SVT_precision GALAHAD_SVT_quadruple #define GALAHAD_TRACE_precision GALAHAD_TRACE_quadruple @@ -775,9 +761,9 @@ #endif #define GALAHAD_SLLS_precision_ciface GALAHAD_SLLS_quadruple_ciface #define GALAHAD_SLLSB_precision_ciface GALAHAD_SLLSB_quadruple_ciface -#define GALAHAD_SNLS_precision_ciface GALAHAD_SNLS_quadruple_ciface #define GALAHAD_SLS_precision_ciface GALAHAD_SLS_quadruple_ciface -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_quadruple_ciface +#define GALAHAD_SNLS_precision_ciface GALAHAD_SNLS_quadruple_ciface +#define GALAHAD_SLBLT_precision_ciface GALAHAD_SLBLT_quadruple_ciface #define GALAHAD_TRB_precision_ciface GALAHAD_TRB_quadruple_ciface #define GALAHAD_TREK_precision_ciface GALAHAD_TREK_quadruple_ciface #define GALAHAD_TRS_precision_ciface GALAHAD_TRS_quadruple_ciface diff --git a/include/galahad_modules_single.h b/include/galahad_modules_single.h index 74dcd6e1e1..c5c0923580 100644 --- a/include/galahad_modules_single.h +++ b/include/galahad_modules_single.h @@ -133,26 +133,19 @@ #endif #define GALAHAD_SLLS_precision GALAHAD_SLLS_single_64 #define GALAHAD_SLLSB_precision GALAHAD_SLLSB_single_64 -#define GALAHAD_SNLS_precision GALAHAD_SNLS_single_64 #define GALAHAD_SLS_precision GALAHAD_SLS_single_64 +#define GALAHAD_SNLS_precision GALAHAD_SNLS_single_64 #define GALAHAD_SMT_precision GALAHAD_SMT_single_64 #define GALAHAD_SORT_precision GALAHAD_SORT_single_64 #define GALAHAD_SPACE_precision GALAHAD_SPACE_single_64 #define GALAHAD_SPECFILE_precision GALAHAD_SPECFILE_single_64 -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_single_64 -#define GALAHAD_SSIDS_akeep_precision GALAHAD_SSIDS_akeep_single_64 -#define GALAHAD_SSIDS_analyse_precision GALAHAD_SSIDS_analyse_single_64 -#define GALAHAD_SSIDS_contrib_free_precision GALAHAD_SSIDS_contrib_free_sgl_64 -#define GALAHAD_SSIDS_contrib_fsub_precision GALAHAD_SSIDS_contrib_fsub_single_64 -#define GALAHAD_SSIDS_contrib_precision GALAHAD_SSIDS_contrib_single_64 -#define GALAHAD_SSIDS_contrib_get_data_precision GALAHAD_SSIDS_contrib_get_data_single_64 -#define GALAHAD_SSIDS_cpu_iface_precision GALAHAD_SSIDS_cpu_iface_single_64 -#define GALAHAD_SSIDS_cpu_subtree_precision GALAHAD_SSIDS_cpu_subtree_single_64 -#define GALAHAD_SSIDS_fkeep_precision GALAHAD_SSIDS_fkeep_single_64 -#define GALAHAD_SSIDS_gpu_subtree_precision GALAHAD_SSIDS_gpu_subtree_single_64 -#define GALAHAD_SSIDS_inform_precision GALAHAD_SSIDS_inform_single_64 -#define GALAHAD_SSIDS_subtree_precision GALAHAD_SSIDS_subtree_single_64 -#define GALAHAD_SSIDS_types_precision GALAHAD_SSIDS_types_single_64 +#define GALAHAD_SLBLT_precision GALAHAD_SLBLT_single_64 +#define GALAHAD_SLBLT_contrib_free_precision GALAHAD_SLBLT_contrib_free_sgl_64 +#define GALAHAD_SLBLT_contrib_get_data_precision GALAHAD_SLBLT_contrib_get_data_single_64 +#define GALAHAD_SLBLT_numeric_subtree_precision GALAHAD_SLBLT_numeric_subtree_single_64 +#define GALAHAD_SLBLT_factor_precision GALAHAD_SLBLT_factor_single_64 +#define GALAHAD_SLBLT_subtree_precision GALAHAD_SLBLT_subtree_single_64 +#define GALAHAD_SLBLT_types_precision GALAHAD_SLBLT_types_single_64 #define GALAHAD_SUPERB_precision GALAHAD_SUPERB_single_64 #define GALAHAD_SVT_precision GALAHAD_SVT_single_64 #define GALAHAD_TRACE_precision GALAHAD_TRACE_single_64 @@ -330,9 +323,9 @@ #endif #define GALAHAD_SLLS_precision_ciface GALAHAD_SLLS_single_ciface_64 #define GALAHAD_SLLSB_precision_ciface GALAHAD_SLLSB_single_ciface_64 -#define GALAHAD_SNLS_precision_ciface GALAHAD_SNLS_single_ciface_64 #define GALAHAD_SLS_precision_ciface GALAHAD_SLS_single_ciface_64 -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_single_ciface_64 +#define GALAHAD_SNLS_precision_ciface GALAHAD_SNLS_single_ciface_64 +#define GALAHAD_SLBLT_precision_ciface GALAHAD_SLBLT_single_ciface_64 #define GALAHAD_TRB_precision_ciface GALAHAD_TRB_single_ciface_64 #define GALAHAD_TREK_precision_ciface GALAHAD_TREK_single_ciface_64 #define GALAHAD_TRS_precision_ciface GALAHAD_TRS_single_ciface_64 @@ -578,26 +571,19 @@ #endif #define GALAHAD_SLLS_precision GALAHAD_SLLS_single #define GALAHAD_SLLSB_precision GALAHAD_SLLSB_single -#define GALAHAD_SNLS_precision GALAHAD_SNLS_single #define GALAHAD_SLS_precision GALAHAD_SLS_single +#define GALAHAD_SNLS_precision GALAHAD_SNLS_single #define GALAHAD_SMT_precision GALAHAD_SMT_single #define GALAHAD_SORT_precision GALAHAD_SORT_single #define GALAHAD_SPACE_precision GALAHAD_SPACE_single #define GALAHAD_SPECFILE_precision GALAHAD_SPECFILE_single -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_single -#define GALAHAD_SSIDS_akeep_precision GALAHAD_SSIDS_akeep_single -#define GALAHAD_SSIDS_analyse_precision GALAHAD_SSIDS_analyse_single -#define GALAHAD_SSIDS_contrib_free_precision GALAHAD_SSIDS_contrib_free_sgl -#define GALAHAD_SSIDS_contrib_fsub_precision GALAHAD_SSIDS_contrib_fsub_single -#define GALAHAD_SSIDS_contrib_precision GALAHAD_SSIDS_contrib_single -#define GALAHAD_SSIDS_contrib_get_data_precision GALAHAD_SSIDS_contrib_get_data_single -#define GALAHAD_SSIDS_cpu_iface_precision GALAHAD_SSIDS_cpu_iface_single -#define GALAHAD_SSIDS_cpu_subtree_precision GALAHAD_SSIDS_cpu_subtree_single -#define GALAHAD_SSIDS_fkeep_precision GALAHAD_SSIDS_fkeep_single -#define GALAHAD_SSIDS_gpu_subtree_precision GALAHAD_SSIDS_gpu_subtree_single -#define GALAHAD_SSIDS_inform_precision GALAHAD_SSIDS_inform_single -#define GALAHAD_SSIDS_subtree_precision GALAHAD_SSIDS_subtree_single -#define GALAHAD_SSIDS_types_precision GALAHAD_SSIDS_types_single +#define GALAHAD_SLBLT_precision GALAHAD_SLBLT_single +#define GALAHAD_SLBLT_contrib_free_precision GALAHAD_SLBLT_contrib_free_sgl +#define GALAHAD_SLBLT_contrib_get_data_precision GALAHAD_SLBLT_contrib_get_data_single +#define GALAHAD_SLBLT_numeric_subtree_precision GALAHAD_SLBLT_numeric_subtree_single +#define GALAHAD_SLBLT_factor_precision GALAHAD_SLBLT_factor_single +#define GALAHAD_SLBLT_subtree_precision GALAHAD_SLBLT_subtree_single +#define GALAHAD_SLBLT_types_precision GALAHAD_SLBLT_types_single #define GALAHAD_SUPERB_precision GALAHAD_SUPERB_single #define GALAHAD_SVT_precision GALAHAD_SVT_single #define GALAHAD_TRACE_precision GALAHAD_TRACE_single @@ -775,9 +761,9 @@ #endif #define GALAHAD_SLLS_precision_ciface GALAHAD_SLLS_single_ciface #define GALAHAD_SLLSB_precision_ciface GALAHAD_SLLSB_single_ciface -#define GALAHAD_SNLS_precision_ciface GALAHAD_SNLS_single_ciface #define GALAHAD_SLS_precision_ciface GALAHAD_SLS_single_ciface -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_single_ciface +#define GALAHAD_SNLS_precision_ciface GALAHAD_SNLS_single_ciface +#define GALAHAD_SLBLT_precision_ciface GALAHAD_SLBLT_single_ciface #define GALAHAD_TRB_precision_ciface GALAHAD_TRB_single_ciface #define GALAHAD_TREK_precision_ciface GALAHAD_TREK_single_ciface #define GALAHAD_TRS_precision_ciface GALAHAD_TRS_single_ciface diff --git a/include/galahad_psls.h b/include/galahad_psls.h index cbe638639f..3c86731bca 100644 --- a/include/galahad_psls.h +++ b/include/galahad_psls.h @@ -1,7 +1,7 @@ //* \file galahad_psls.h */ /* - * THIS VERSION: GALAHAD 4.3 - 2024-02-10 AT 14:45 GMT. + * THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 14:45 GMT. * *-*-*-*-*-*-*-*-*- GALAHAD_PSLS C INTERFACE *-*-*-*-*-*-*-*-*-*- * @@ -81,7 +81,7 @@ \c HSL_MA86 left-looking yes no OpenMP fully \c HSL_MA87 left-looking no no OpenMP fully \c HSL_MA97 multifrontal yes no OpenMP core - \c SSIDS multifrontal yes no CUDA core + \c SLBLT multifrontal yes no OpenMP core \c MUMPS multifrontal yes optionally MPI \c PARDISO left-right-looking yes no OpenMP fully \c MKL_PARDISO left-right-looking yes optionally @@ -103,7 +103,7 @@ External solver characteristics (ooc = out-of-core factorization) HSL_MA86 left-looking yes no OpenMP fully HSL_MA87 left-looking no no OpenMP fully HSL_MA97 multifrontal yes no OpenMP core - SSIDS multifrontal yes no CUDA core + SLBLT multifrontal yes no OpenMP core MUMPS multifrontal yes optionally MPI PARDISO left-right-looking yes no OpenMP fully MKL_PARDISO left-right-looking yes optionally OpenMP fully @@ -363,18 +363,17 @@ struct psls_control_type { /// \brief /// the symmetric linear equation solver used when .preconditioner = 5. /// Possible choices are currently: - /// sils, ma27, ma57, ma77, ma86, ma87, ma97, ssids, mumps, pardiso, - /// mkl_pardiso,pastix, wsmp, sytr, potr and pbtr, although only sils, sytr, - /// and for OMP 4.0-compliant compilers, ssids are installed by default. + /// sils, ma27, ma57, ma77, ma86, ma87, ma97, slblt, mumps, pardiso, + /// mkl_pardiso,pastix, wsmp, sytr, potr and pbtr, although only sils, sytr + /// and slblt are installed by default. char symmetric_linear_solver[31]; /// \brief /// the definite linear equation solver used when .preconditioner = 4. /// Possible choices are currently: - /// sils, ma27, ma57, ma77, ma86, ma87, ma97, ssids, mumps, pardiso, + /// sils, ma27, ma57, ma77, ma86, ma87, ma97, slblt, mumps, pardiso, /// mkl_pardiso,pastix, wsmp, potr and pbtr, although only sils, potr, - /// pbtr and, - /// for OMP 4.0-compliant compilers, ssids are installed by default. + /// pbtr and slblt are installed by default. char definite_linear_solver[31]; /// \brief diff --git a/include/galahad_ssids.h b/include/galahad_slblt.h similarity index 52% rename from include/galahad_ssids.h rename to include/galahad_slblt.h index 83a91a4e75..36d23f1f6c 100644 --- a/include/galahad_ssids.h +++ b/include/galahad_slblt.h @@ -1,4 +1,4 @@ -//* \file galahad_ssids.h */ +//* \file galahad_slblt.h */ /** * \version GALAHAD 5.3 - 2025-08-25 AT 14:10 GMT */ @@ -11,8 +11,8 @@ extern "C" { #endif // include guard -#ifndef GALAHAD_SSIDS_H -#define GALAHAD_SSIDS_H +#ifndef GALAHAD_SLBLT_H +#define GALAHAD_SLBLT_H // precision #include "galahad_precision.h" @@ -25,7 +25,7 @@ extern "C" { * Derived types ************************************/ -struct ssids_control_type { +struct slblt_control_type { ipc_ array_base; // Not in Fortran type ipc_ print_level; ipc_ unit_diagnostics; @@ -34,27 +34,22 @@ struct ssids_control_type { ipc_ ordering; ipc_ nemin; bool ignore_numa; - bool use_gpu; - bool gpu_only; - int64_t min_gpu_work; real_sp_ max_load_inbalance; - real_sp_ gpu_perf_coeff; ipc_ scaling; int64_t small_subtree_threshold; - ipc_ cpu_block_size; + ipc_ block_size; bool action; ipc_ pivot_method; rpc_ small; rpc_ u; struct nodend_control_type nodend_control; - ipc_ nstream; rpc_ multiplier; real_sp_ min_loadbalance; ipc_ failed_pivot_method; // char unused[80]; // Allow for future expansion }; -struct ssids_inform_type { +struct slblt_inform_type { ipc_ flag; ipc_ matrix_dup; ipc_ matrix_missing_diag; @@ -70,14 +65,11 @@ struct ssids_inform_type { ipc_ num_sup; ipc_ num_two; ipc_ stat; - ipc_ cuda_error; - ipc_ cublas_error; struct nodend_inform_type nodend_inform; ipc_ not_first_pass; ipc_ not_second_pass; ipc_ nparts; - int64_t cpu_flops; - int64_t gpu_flops; + int64_t flops; // char unused[76]; // Allow for future expansion }; @@ -86,62 +78,62 @@ struct ssids_inform_type { ************************************/ /* Initialize control to defaults */ -void ssids_default_control(struct ssids_control_type *control); +void slblt_default_control(struct slblt_control_type *control); /* Perform analysis phase for CSC data */ -void ssids_analyse(bool check, ipc_ n, ipc_ *order, const int64_t *ptr, +void slblt_analyse(bool check, ipc_ n, ipc_ *order, const int64_t *ptr, const ipc_ *row, const rpc_ *val, void **akeep, - const struct ssids_control_type *control, - struct ssids_inform_type *inform); -void ssids_analyse_ptr32(bool check, ipc_ n, ipc_ *order, const ipc_ *ptr, + const struct slblt_control_type *control, + struct slblt_inform_type *inform); +void slblt_analyse_ptr32(bool check, ipc_ n, ipc_ *order, const ipc_ *ptr, const ipc_ *row, const rpc_ *val, void **akeep, - const struct ssids_control_type *control, - struct ssids_inform_type *inform); + const struct slblt_control_type *control, + struct slblt_inform_type *inform); /* Perform analysis phase for coordinate data */ -void ssids_analyse_coord(ipc_ n, ipc_ *order, int64_t ne, const ipc_ *row, +void slblt_analyse_coord(ipc_ n, ipc_ *order, int64_t ne, const ipc_ *row, const ipc_ *col, const rpc_ *val, void **akeep, - const struct ssids_control_type *control, - struct ssids_inform_type *inform); + const struct slblt_control_type *control, + struct slblt_inform_type *inform); /* Perform numerical factorization */ -void ssids_factor(bool posdef, const int64_t *ptr, const ipc_ *row, +void slblt_factor(bool posdef, const int64_t *ptr, const ipc_ *row, const rpc_ *val, rpc_ *scale, void *akeep, void **fkeep, - const struct ssids_control_type *control, - struct ssids_inform_type *inform); -void ssids_factor_ptr32(bool posdef, const ipc_ *ptr, const ipc_ *row, + const struct slblt_control_type *control, + struct slblt_inform_type *inform); +void slblt_factor_ptr32(bool posdef, const ipc_ *ptr, const ipc_ *row, const rpc_ *val, rpc_ *scale, void *akeep, void **fkeep, - const struct ssids_control_type *control, - struct ssids_inform_type *inform); + const struct slblt_control_type *control, + struct slblt_inform_type *inform); /* Perform triangular solve(s) for single rhs */ -void ssids_solve1(ipc_ job, rpc_ *x1, void *akeep, void *fkeep, - const struct ssids_control_type *control, - struct ssids_inform_type *inform); +void slblt_solve1(ipc_ job, rpc_ *x1, void *akeep, void *fkeep, + const struct slblt_control_type *control, + struct slblt_inform_type *inform); /* Perform triangular solve(s) for one or more rhs */ -void ssids_solve(ipc_ job, ipc_ nrhs, rpc_ *x, ipc_ ldx, void *akeep, - void *fkeep, const struct ssids_control_type *control, - struct ssids_inform_type *inform); +void slblt_solve(ipc_ job, ipc_ nrhs, rpc_ *x, ipc_ ldx, void *akeep, + void *fkeep, const struct slblt_control_type *control, + struct slblt_inform_type *inform); /* Free memory */ -ipc_ ssids_free_akeep(void **akeep); -ipc_ ssids_free_fkeep(void **fkeep); -ipc_ ssids_free(void **akeep, void **fkeep); +ipc_ slblt_free_akeep(void **akeep); +ipc_ slblt_free_fkeep(void **fkeep); +ipc_ slblt_free(void **akeep, void **fkeep); /************************************ * Advanced subroutines ************************************/ /* Retrieve information on pivots (positive-definite case) */ -void ssids_enquire_posdef(const void *akeep, const void *fkeep, - const struct ssids_control_type *control, - struct ssids_inform_type *inform, rpc_ *d); +void slblt_enquire_posdef(const void *akeep, const void *fkeep, + const struct slblt_control_type *control, + struct slblt_inform_type *inform, rpc_ *d); /* Retrieve information on pivots (indefinite case) */ -void ssids_enquire_indef(const void *akeep, const void *fkeep, - const struct ssids_control_type *control, - struct ssids_inform_type *inform, ipc_ *piv_order, rpc_ *d); +void slblt_enquire_indef(const void *akeep, const void *fkeep, + const struct slblt_control_type *control, + struct slblt_inform_type *inform, ipc_ *piv_order, rpc_ *d); /* Alter pivots (indefinite case only) */ -void ssids_alter(const rpc_ *d, const void *akeep, void *fkeep, - const struct ssids_control_type *control, - struct ssids_inform_type *inform); +void slblt_alter(const rpc_ *d, const void *akeep, void *fkeep, + const struct slblt_control_type *control, + struct slblt_inform_type *inform); #ifdef __cplusplus } /* extern "C" */ #endif -#endif // GALAHAD_SSIDS_H +#endif // GALAHAD_SLBLT_H diff --git a/include/galahad_sls.h b/include/galahad_sls.h index ba737ccb9f..d82d8823ee 100644 --- a/include/galahad_sls.h +++ b/include/galahad_sls.h @@ -1,7 +1,7 @@ //* \file galahad_sls.h */ /* - * THIS VERSION: GALAHAD 5.2 - 2025-03-23 AT 13:50 GMT + * THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 13:50 GMT * *-*-*-*-*-*-*-*-*- GALAHAD_SLS C INTERFACE *-*-*-*-*-*-*-*-*-*- * @@ -32,7 +32,7 @@ solvers from HSL and elsewhere. Currently supported solvers include \c MA27/SILS, \c HSL\_MA57, \c HSL\_MA77, \c HSL\_MA86, \c HSL\_MA87 and \c HSL\_MA97 from HSL, - \c SSIDS from SPRAL, + \c SLBLT from GALAHAD, \c MUMPS from Mumps Technologies, \c PARDISO both from the Pardiso Project and Intel's MKL, \c PaStix from Inria @@ -87,7 +87,7 @@ \c HSL_MA86 left-looking yes no OpenMP fully \c HSL_MA87 left-looking no no OpenMP fully \c HSL_MA97 multifrontal yes no OpenMP core - \c SSIDS multifrontal yes no CUDA core + \c SLBLT multifrontal yes no OpenMP core \c MUMPS multifrontal yes optionally MPI \c PARDISO left-right-looking yes no OpenMP fully \c MKL_PARDISO left-right-looking yes optionally @@ -109,7 +109,7 @@ External solver characteristics (ooc = out-of-core factorization) HSL_MA86 left-looking yes no OpenMP fully HSL_MA87 left-looking no no OpenMP fully HSL_MA97 multifrontal yes no OpenMP core - SSIDS multifrontal yes no CUDA core + SLBLT multifrontal yes no OpenMP core MUMPS multifrontal yes optionally MPI PARDISO left-right-looking yes no OpenMP fully MKL_PARDISO left-right-looking yes optionally OpenMP fully @@ -143,9 +143,6 @@ To obtain HSL 2011 packages, see http://hsl.rl.ac.uk -The solver \c SSIDS is from the SPRAL sparse-matrix collection, -and is available as part of GALAHAD. - The solver \c MUMPS is available from Mumps Technologies in France, and version 5.5.1 or above is sufficient. To obtain \c MUMPS, see @@ -351,7 +348,7 @@ extern "C" { #include "hsl_ma87.h" #include "hsl_ma97.h" #include "galahad_nodend.h" -#include "galahad_ssids.h" +#include "galahad_slblt.h" #include "hsl_mc64.h" #include "hsl_mc68.h" @@ -910,8 +907,8 @@ struct sls_inform_type { struct ma97_info ma97_info; /// \brief - /// the output structure from ssids - struct ssids_inform_type ssids_inform; + /// the output structure from slblt + struct slblt_inform_type slblt_inform; /// \brief /// the output structure from nodend @@ -996,7 +993,7 @@ void sls_initialize( const char solver[], @param[in] solver is a one-dimensional array of type char that specifies the \link external solver package \endlink that should be used to factorize the matrix \f$A\f$. It should be one of - 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'ssids', 'mumps', + 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl pardiso', 'pastix', 'wsmp', 'potr', 'sytr' or 'pbtr'; lower or upper case variants are allowed. diff --git a/include/meson.build b/include/meson.build index d7cd179c6e..27b4f48e9a 100644 --- a/include/meson.build +++ b/include/meson.build @@ -64,11 +64,11 @@ if build_ciface 'galahad_sec.h', 'galahad_sha.h', 'galahad_sils.h', + 'galahad_slblt.h', 'galahad_slls.h', 'galahad_sllsb.h', 'galahad_sls.h', 'galahad_snls.h', - 'galahad_ssids.h', 'galahad_ssls.h', 'galahad_trb.h', 'galahad_trek.h', diff --git a/include/ssids_compat.hxx b/include/ssids_compat.hxx deleted file mode 100644 index 6fca5b2325..0000000000 --- a/include/ssids_compat.hxx +++ /dev/null @@ -1,20 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * - * \brief - * Implements compatability functions depending on the value of autoconf macros. - */ -#pragma once - -#include -#include - -#include "ssids_config.h" - -#ifndef _OPENMP -inline int omp_get_thread_num(void) { return 0; } -inline int omp_get_num_threads(void) { return 1; } -inline int omp_get_max_threads(void) { return 1; } -#endif /* _OPENMP */ diff --git a/include/ssids_config.h b/include/ssids_config.h deleted file mode 100644 index 8a17e438d8..0000000000 --- a/include/ssids_config.h +++ /dev/null @@ -1,99 +0,0 @@ -/* config.h. Generated from config.h.in by configure. */ -/* config.h.in. Generated from configure.ac by autoheader. */ - -/* Define to dummy `main' function (if any) required to link to the Fortran - libraries. */ -/* #undef F77_DUMMY_MAIN */ - -/* Define if F77 and FC dummy `main' functions are identical. */ -/* #undef FC_DUMMY_MAIN_EQ_F77 */ - -/* Define if you have a BLAS library. */ -#define HAVE_BLAS 1 - -/* Define if you have a GTG library. */ -/* #undef HAVE_GTG */ - -/* Define if you have hwloc library */ -/* #undef HAVE_HWLOC */ -/* #define HAVE_HWLOC 1 */ -#ifdef SPRAL_NO_HWLOC -#undef HAVE_HWLOC -#else -#define HAVE_HWLOC 1 -#endif - -/* Define to 1 if you have the header file. */ -#define HAVE_INTTYPES_H 1 - -/* Define if you have LAPACK library. */ -#define HAVE_LAPACK 1 - -/* Define to 1 if you have the header file. */ -#define HAVE_MEMORY_H 1 - -/* Define if you have a MeTiS library. */ -#define HAVE_METIS 1 - -/* Define to 1 if you are compiling against NVCC */ -/* #undef HAVE_NVCC */ - -/* Define to 1 if you have sched_getcpu(). */ -/* #define HAVE_SCHED_GETCPU 1 */ -/* #undef HAVE_SCHED_GETCPU */ -#ifdef SPRAL_NO_SCHED_GETCPU -#undef HAVE_SCHED_GETCPU -#else -#define HAVE_SCHED_GETCPU 1 -#endif - -/* Define to 1 if you have the header file. */ -#define HAVE_STDINT_H 1 - -/* Define to 1 if you have the header file. */ -#define HAVE_STDLIB_H 1 - -/* Define to 1 if you have std::align(). */ -/* #undef HAVE_STD_ALIGN */ - -/* Define to 1 if you have the header file. */ -#define HAVE_STRINGS_H 1 - -/* Define to 1 if you have the header file. */ -#define HAVE_STRING_H 1 - -/* Define to 1 if you have the header file. */ -#define HAVE_SYS_STAT_H 1 - -/* Define to 1 if you have the header file. */ -#define HAVE_SYS_TYPES_H 1 - -/* Define to 1 if you have the header file. */ -#define HAVE_UNISTD_H 1 - -/* Name of package */ -#define PACKAGE "ssids" - -/* Define to the address where bug reports for this package should be sent. */ -#define PACKAGE_BUGREPORT "jonathan.hogg@stfc.ac.uk" - -/* Define to the full name of this package. */ -#define PACKAGE_NAME "ssids" - -/* Define to the full name and version of this package. */ -#define PACKAGE_STRING "spral 2023.11.15" - -/* Define to the one symbol short name of this package. */ -#define PACKAGE_TARNAME "spral" - -/* Define to the home page for this package. */ -#define PACKAGE_URL "" - -/* Define to the version of this package. */ -#define PACKAGE_VERSION "2023.11.15" - -/* Define to 1 if you have the ANSI C header files. */ -#define STDC_HEADERS 1 - -/* Version number of package */ -#define VERSION "2023.11.15" diff --git a/include/ssids_contrib.h b/include/ssids_contrib.h deleted file mode 100644 index 4f80145e1e..0000000000 --- a/include/ssids_contrib.h +++ /dev/null @@ -1,33 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-19 AT 09:30 GMT - * - * \brief Defines C++ interface to routines from galahad_ssids_contrib and - * galahad_ssids_contrib_free modules. - */ - -#include "galahad_modules.h" -#include "galahad_precision.h" - -#ifndef GALAHAD_SSIDS_CONTRIB_H -#define GALAHAD_SSIDS_CONTRIB_H - -#ifdef __cplusplus -extern "C" { -#endif - -void galahad_ssids_contrib_get_data(const void *const contrib, - ipc_ *const n, const rpc_* *const val, ipc_ *const ldval, - const ipc_* *const rlist, ipc_ *const ndelay, - const ipc_* *const delay_perm, - const rpc_* *const delay_val, ipc_ *const lddelay); - -void galahad_ssids_contrib_free(void *const contrib); - -#ifdef __cplusplus -} -#endif - -#endif /* GALAHAD_SSIDS_CONTRIB_H */ diff --git a/include/ssids_cpu_AppendAlloc.hxx b/include/ssids_cpu_AppendAlloc.hxx deleted file mode 100644 index e8c885c391..0000000000 --- a/include/ssids_cpu_AppendAlloc.hxx +++ /dev/null @@ -1,144 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 09:00 GMT - */ - -#pragma once - -//#define MEM_STATS - -#include - -#include "ssids_routines.h" -#include "galahad_precision.h" -#include "ssids_compat.hxx" // for std::align if required - -namespace galahad { namespace ssids { namespace cpu { - -namespace append_alloc_internal { - -/** A single fixed size page of memory with allocate function. - * We are required to guaruntee it is zero'd, so use calloc rather than anything - * else for the allocation. - * Deallocation is not supported. - */ -class Page { -#if defined(__AVX512F__) - static const ipc_ align = 64; // 64 byte alignment -#elif defined(__AVX__) - static const ipc_ align = 32; // 32 byte alignment -#else - static const ipc_ align = 16; // 16 byte alignment -#endif -public: - Page(size_t sz, Page* next=nullptr) - : next(next), mem_(calloc(sz+align, 1)), ptr_(mem_), space_(sz+align) - { - if(!mem_) throw std::bad_alloc(); - } - ~Page() { -#ifdef MEM_STATS - uintptr_t used = - reinterpret_cast(ptr_) - reinterpret_cast(mem_); - uintptr_t total = used + space_; - printf("AppendAlloc: Allocated %16ld (%.2e GB)\n", - total, 1e-9*double(used)); - printf("AppendAlloc: Used %16ld (%.2e GB)\n", - used, 1e-9*double(used)); -#endif /* MEM_STATS */ - free(mem_); - } - void* allocate(size_t sz) { - if(!std::align(align, sz, ptr_, space_)) return nullptr; - void* ret = ptr_; - ptr_ = (char*)ptr_ + sz; - space_ -= sz; - return ret; - } -public: - Page* const next; -private: - void *const mem_; // Pointer to memory so we can free it - void *ptr_; // Next address to return - size_t space_; // Amount of free memory -}; - -/** A memory allocation pool consisting of one or more pages. - * Deallocation is not supported. - */ -class Pool { -// const size_t PAGE_SIZE = 8*1024*1024; // 8MB - const size_t PAGE_SIZE = 0; // recommended by mjacobse -public: - Pool(size_t initial_size) - : top_page_(new Page(std::max(PAGE_SIZE, initial_size))) - {} - Pool(const Pool&) =delete; // Not copyable - Pool& operator=(const Pool&) =delete; // Not copyable - ~Pool() { - /* Iterate over linked list deleting pages */ - for(Page* page=top_page_; page; ) { - Page* next = page->next; - delete page; - page = next; - } - } - void* allocate(size_t sz) { - void* ptr; - #pragma omp critical - { - ptr = top_page_->allocate(sz); - if(!ptr) { // Insufficient space on current top page, make a new one - top_page_ = new Page(std::max(PAGE_SIZE, sz), top_page_); - ptr = top_page_->allocate(sz); - } - } - return ptr; - } -private: - Page* top_page_; -}; - -} /* namespace galahad::ssids::cpu::append_alloc_internal */ - -/** An allocator built on top of a pool of pages, with expectation of - * sequential allocation, and then everything deallocated at the end. - * Deallocation is not supported. - */ -template -class AppendAlloc { -public : - typedef T value_type; - - AppendAlloc(size_t initial_size) - : pool_(new append_alloc_internal::Pool(initial_size)) - {} - - /** Rebind a type T to a type U AppendAlloc */ - template - AppendAlloc(AppendAlloc &other) - : pool_(other.pool_) - {} - - T* allocate(std::size_t n) { - return static_cast(pool_->allocate(n*sizeof(T))); - } - void deallocate(T* p, std::size_t n) { - throw std::runtime_error("Deallocation not supported on AppendAlloc"); - } - template - bool operator==(AppendAlloc const& rhs) { - return true; - } - template - bool operator!=(AppendAlloc const& rhs) { - return !(*this==rhs); - } -protected: - std::shared_ptr pool_; - template friend class AppendAlloc; -}; - -}}} /* namepsace galahad::ssids::cpu */ diff --git a/include/ssids_cpu_BlockPool.hxx b/include/ssids_cpu_BlockPool.hxx deleted file mode 100644 index 7968199609..0000000000 --- a/include/ssids_cpu_BlockPool.hxx +++ /dev/null @@ -1,102 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 09:00 GMT - */ -#pragma once - -#include -#include -#include - -#include "ssids_routines.h" -#include "galahad_precision.h" -#include "ssids_omp.hxx" - -namespace galahad { namespace ssids { namespace cpu { - -/** Pool of blocks that can be aquired/released, providing a way to cap - * memory usage whilst avoiding fragmentation. - * Further, guaruntees blocks are aligned to 32-byte boundaries so are - * suitable for AVX usage. */ -template -class BlockPool { - typedef typename std::allocator_traits::template rebind_traits CharAllocTraits; -#if defined(__AVX512F__) - static const std::size_t align_ = 64; //< Alignment for AVX512 is 64 bytes -#elif defined(__AVX__) - static const std::size_t align_ = 32; //< Alignment for AVX(2) is 32 bytes -#else - static const std::size_t align_ = 16; //< Alignment for SSE(2,3,4.1,4.2) or Power's VSX is 16 bytes -#endif -public: - /* Not copyable */ - BlockPool(BlockPool const&) =delete; - BlockPool& operator=(BlockPool const&) =delete; - /** Constructor allocates memory pool */ - BlockPool(std::size_t num_blocks, std::size_t block_dimn, Allocator const& alloc=Allocator()) - : alloc_(alloc), num_blocks_(num_blocks), block_dimn_(block_dimn) - { - // Calculate size in elements - std::size_t sz = block_dimn_*block_dimn_*sizeof(T); - block_size_ = align_*((sz-1)/align_ + 1); - mem_ = CharAllocTraits::allocate(alloc_, num_blocks*block_size_); - // Set up stack of free blocks such that we issue them in order - try { - pool_.reserve(num_blocks); // only this can throw (push_back is reserved) - for(int i=num_blocks-1; i>=0; --i) { - pool_.push_back(reinterpret_cast(mem_ + i*block_size_)); - } - } catch(...) { - // ~BlockPool won't run (ctor didn't finish): free mem_ so it doesn't leak - CharAllocTraits::deallocate(alloc_, mem_, num_blocks*block_size_); - throw; - } - } - ~BlockPool() { - // FIXME: Throw an exception if we've not had all memory returned? - CharAllocTraits::deallocate(alloc_, mem_, num_blocks_*block_size_); - } - - /** Get next free block in a thread-safe fashion. - * Return nullptr if it can't find a free block. - */ - T *get_nowait() { - T *ptr = nullptr; - galahad::omp::AcquiredLock scopeLock(lock_); - if(pool_.size() > 0) { - ptr = pool_.back(); - pool_.pop_back(); - } - return ptr; - } - /** Get next free block in a thread-safe fashion. - * Keep trying until it suceeds, use taskyield after each try. - * NB: This may deadlock if there are no other tasks releasing blocks. - */ - T *get_wait() { - while(true) { - T *ptr = get_nowait(); - if(ptr) { - return ptr; - } - #pragma omp taskyield - } - } - /** Release block acquired using get_*() function for reuse */ - void release(T *const ptr) { - galahad::omp::AcquiredLock scopeLock(lock_); - pool_.push_back(ptr); - } -private: - typename CharAllocTraits::allocator_type alloc_; - std::size_t num_blocks_; //< Number of blocks - std::size_t block_dimn_; //< Blocks are block_size_ x block_size_ elements - std::size_t block_size_; //< Size of an aligned block in bytes - char* mem_; //< pointer to allocated memory - std::vector pool_; //< stack of free blocks - galahad::omp::Lock lock_; //< lock used for safe access to pool_ -}; - -}}} /* namespace galahad::ssids::cpu */ diff --git a/include/ssids_cpu_BuddyAllocator.hxx b/include/ssids_cpu_BuddyAllocator.hxx deleted file mode 100644 index 3ee2e35446..0000000000 --- a/include/ssids_cpu_BuddyAllocator.hxx +++ /dev/null @@ -1,422 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 09:00 GMT - */ -#pragma once - -//#define MEM_STATS - -#include - -#include "ssids_routines.h" -#include "galahad_precision.h" -#include "ssids_omp.hxx" - -namespace galahad { namespace ssids { namespace cpu { - -namespace buddy_alloc_internal { - -/** - * \brief Single Buddy Allocator Page. True buddy allocator. - * - * Manages a pool of memory. Upon an allocation requires, the pool is - * repeatedly divided into two halves until an area "just big enough" for the - * requested allocation is obtained, and returned to the user. The unused halves - * resulting from this process are stored in free lists. Upon deallocation, - * if the corresponding half(s) are still free, they are recombined to obtain - * a larger allocation unit as far as possible. - * - * This design prevents memory fragmentation and enables cheap reuse at the cost - * of some inefficiency in memory allocation. - * - * \tparam CharAllocator Underlying allocator, must allocate pointers of type - * char. - * \sa Table - * \sa BuddyAllocator - */ -template > -class Page { - // \{ - typedef typename std::allocator_traits::template rebind_traits IntAllocTraits; - // \} - static ipc_ const nlevel=16; ///< Number of divisions to smallest allocation unit. - -#if defined(__AVX512F__) - static ipc_ const align=64; ///< Underlying alignment of all pointers returned -#elif defined(__AVX__) - static ipc_ const align=32; ///< Underlying alignment of all pointers returned -#else - static ipc_ const align=16; ///< Underlying alignment of all pointers returned -#endif - static ipc_ const ISSUED_FLAG = -2; ///< Flag: value is issued -public: - // \{ - Page(Page const&) =delete; // not copyable - Page& operator=(Page const&) =delete; // not copyable - // \} - /** - * \brief (Constructor) - * - * \param size Minimum size of underlying memory area to be allocated and - * managed. A larger area may be used to allow for alignment and to - * ensure sufficient levels of division are available. - * \param alloc Allocator to be used for allocation of underlying memory - * area. - */ - Page(size_t size, CharAllocator const &alloc=CharAllocator()) - : alloc_(alloc) - { - min_size_ = std::max(size_t(1), (size-1) / (1<<(nlevel-1)) + 1); - min_size_ = align * ((min_size_-1)/align + 1); // make muliple of align - size_ = min_size_<<(nlevel-1); - /* Allocate memory of sufficient size and align it */ - mem_ = std::allocator_traits::allocate(alloc_, size_+align); - size_t space = size_+align; - void* to_align = mem_; - std::align(align, size, to_align, space); - base_ = static_cast(to_align); - typename IntAllocTraits::allocator_type intAlloc(alloc_); - try { - next_ = IntAllocTraits::allocate(intAlloc, 1<<(nlevel-1)); - } catch(...) { - // ~Page won't run (ctor didn't finish): free mem_ so it doesn't leak - std::allocator_traits::deallocate(alloc_, mem_, size_+align); - throw; - } - /* Initialize data structures */ - head_[nlevel-1] = 0; next_[0] = -1; // a single free block at top level - for(ipc_ i=0; i::deallocate( - alloc_, mem_, size_+align - ); - } - /** - * \brief Allocate a pointer of given size. - * - * \return Pointer to memory, aligned as per align. Or nullptr if there is - * insufficient space. - */ - void* allocate(std::size_t sz) { - if(sz > size_) return nullptr; // too big: don't even try - // Determine which level of block we're trying to find - ipc_ level = sz_to_level(sz); - void* ptr = addr_to_ptr(get_next_ptr(level)); -#ifdef MEM_STATS - if(ptr) { - used_ += sz; - max_used_ = std::max(max_used_, used_); - } -#endif /* MEM_STATS */ - return ptr; - } - /** \brief Release memory associated with ptr for reuse. */ - void deallocate(void* ptr, std::size_t sz) { - ipc_ idx = ptr_to_addr(ptr); - ipc_ level = sz_to_level(sz); - mark_free(idx, level); -#ifdef MEM_STATS - used_ -= sz; -#endif /* MEM_STATS */ - } - /** \brief Return true if this Page owners given pointer */ - bool is_owner(void* ptr) { - ipc_ idx = ptr_to_addr(ptr); - return (idx>=0 && idx<(1<<(nlevel-1))); - } - /** - * \brief Return number of free bytes that could be allocated. - * - * Number returned is theoretical, and assumes exactly right sizes are - * chosen to maximize usage. - * */ - size_t count_free() const { - size_t free=0; - for(ipc_ i=0; i=nlevel) return -1; // invalid level - if(head_[level] == -1) { - // Need to split next level up to get one - ipc_ above = get_next_ptr(level+1); - if(above==-1) return -1; // couldn't find one - split_block(level+1, above); - } - ipc_ p = head_[level]; - head_[level] = next_[p]; - next_[p] = ISSUED_FLAG; - return p; - } - - /** Marks given block as free, tries to merge with partner if possible */ - void mark_free(ipc_ idx, ipc_ level) { - if(level < nlevel-1) { - // There exists a partner, see if we can merge with it - ipc_ partner = get_partner(idx, level); - if(next_[partner] != ISSUED_FLAG) { - // Partner is free in *some* list, not necessarily this level - if(remove_from_free_list(partner, level)) { - // It was this level - we can merge - mark_free(std::min(idx, partner), level+1); - return; - } - } - } - // Otherwise, can't merge, add to free list - next_[idx] = head_[level]; - head_[level] = idx; - } - - /** Finds the given address in free list for level and removes it. - * Returns false if it cannot be found, true otherwise. - */ - bool remove_from_free_list(ipc_ idx, ipc_ level) { - ipc_ prev = -1; - ipc_ current = head_[level]; - while(current!=-1 && current != idx) { - prev = current; - current = next_[current]; - } - if(current != idx) return false; // can't find it - if(prev==-1) { - // at the head - head_[level] = next_[idx]; - } else { - // in the middle - next_[prev] = next_[idx]; - } - return true; // success - } - - /** Splits the given block */ - void split_block(ipc_ level, ipc_ block) { - ipc_ left = block; - ipc_ right = get_partner(block, level-1); - next_[right] = head_[level-1]; - next_[left] = right; - head_[level-1] = left; - } - - /** Given address location, return pointer */ - void* addr_to_ptr(ipc_ idx) { - return (idx==-1) ? nullptr : base_ + idx*min_size_; - } - - /** Given pointer, return address */ - ipc_ ptr_to_addr(void* ptr) { - return - static_cast(static_cast(ptr)-base_) / min_size_; - } - - /** Given a size, find the relevant level */ - ipc_ sz_to_level(std::size_t sz) { - ipc_ val = sz / min_size_; - // Find next power of 2 higher than val - ipc_ level = 0; - while((val>>level) > 0) ++level; - return level; - } - - /** Given an index find its partner at given level */ - ipc_ get_partner(ipc_ idx, ipc_ level) { - return idx ^ (1< -class Table { - // \{ - typedef Page PageSpec; - typedef typename std::allocator_traits::template rebind_alloc PageAlloc; - // \} -public: - // \{ - Table(const Table&) =delete; - Table& operator=(const Table&) =delete; - // \} - /** - * \brief (Constructor) - * - * \param sz Size of initial page. - * \param alloc Underlying allocator to use. - */ - Table(std::size_t sz, CharAllocator const& alloc=CharAllocator()) - : alloc_(alloc), max_sz_(sz), pages_(PageAlloc(alloc)) - { - pages_.emplace_back(max_sz_, alloc_); - } - - /** - * \brief Allocate and return a pointer of the given size. - * - * If there is insufficient space on existing pages, create a new one. - */ - void* allocate(std::size_t sz) { - // Try allocating in existing pages - galahad::omp::AcquiredLock scopeLock(lock_); - void* ptr = nullptr; - for(auto& page: pages_) { - ptr = page.allocate(sz); - if(ptr) break; // allocation suceeded - } - if(!ptr) { - //if(ptr == NULL) { - // Failed to alloc on existing page: make a bigger page and use it -#ifdef MEM_STATS - printf("Failed to allocate %ld on existing page...\n", sz); - for(auto& page: pages_) - page.print(); -#endif /* MEM_STATS */ - size_t old_max_sz = max_sz_; - try { - max_sz_ = std::max(2*max_sz_, sz); - pages_.emplace_back(max_sz_, alloc_); - } catch(std::bad_alloc const&) { - // Failed to alloc block twice as big, try one the same size - max_sz_ = old_max_sz; - try { - max_sz_ = std::max(max_sz_, sz); - pages_.emplace_back(max_sz_, alloc_); - } catch(std::bad_alloc const&) { - // That didn't work either, try one of just big enough for sz - pages_.emplace_back(sz, alloc_); - // If this fails, we just give up and propogate std::bad_alloc - } - } - ptr = pages_.back().allocate(sz); - } - return ptr; - } - - /** \brief Release memory starting at ptr of size sz back to pool */ - void deallocate(void* ptr, std::size_t sz) { - // Find page ptr belongs to and call it's deallocate function - galahad::omp::AcquiredLock scopeLock(lock_); - for(auto& page: pages_) { - if(page.is_owner(ptr)) { - page.deallocate(ptr, sz); - break; - } - } - } - -private: - CharAllocator alloc_; ///< Underlying allocator to be passed to new pages - std::size_t max_sz_; ///< Size of last page allocated - std::vector pages_; ///< Individual buddy allocators - galahad::omp::Lock lock_; ///< Underlying OpenMP lock -}; - -} /* namespace buddy_alloc_internal */ - -/** - * \brief Simple buddy-system allocator. - * - * Designed to prevents memory fragmentation and enables cheap reuse at the cost - * of some inefficiency in memory allocation. - * - * Actually a type-specific wrapper around the type-agnostic Table. - * - * \sa buddy_alloc_internal::Table - * \sa buddy_alloc_internal::Page - */ -template -class BuddyAllocator { - typedef typename std::allocator_traits::template rebind_alloc CharAllocator; -public: - typedef T value_type; - - BuddyAllocator(size_t size, BaseAllocator const& base=BaseAllocator()) - : table_(new buddy_alloc_internal::Table(size*sizeof(T), base)) - {} - template - BuddyAllocator(BuddyAllocator const& other) - : table_(other.table_) - {} - - T* allocate(std::size_t n) - { - return static_cast(table_.get()->allocate(n*sizeof(T))); - } - - void deallocate(T* ptr, std::size_t n) - { - table_.get()->deallocate(ptr, n*sizeof(T)); - } -private: - std::shared_ptr> table_; - template - friend class BuddyAllocator; -}; - -}}} /* namespaces galahad::ssids::cpu */ diff --git a/include/ssids_cpu_NumericNode.hxx b/include/ssids_cpu_NumericNode.hxx deleted file mode 100644 index caa849ac1d..0000000000 --- a/include/ssids_cpu_NumericNode.hxx +++ /dev/null @@ -1,83 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 08:00 GMT - */ - -#pragma once - -#include "ssids_routines.h" -#include "galahad_precision.h" - -namespace galahad { namespace ssids { namespace cpu { - -class SymbolicNode; - -template -class NumericNode { - typedef std::allocator_traits PATraits; -public: - /** - * \brief Constructor - * \param symb Associated symbolic node. - * \param pool_alloc Pool Allocator to use for contrib allocation. - */ - NumericNode(SymbolicNode const& symb, PoolAllocator const& pool_alloc) - : symb(symb), contrib(nullptr), pool_alloc_(pool_alloc) - {} - /** - * \brief Destructor - */ - ~NumericNode() { - free_contrib(); - } - - /** - * \brief Allocate space for contribution block. - * - * Note done at construction time, as a major memory commitment that is - * transitory. - */ - void alloc_contrib() { - size_t contrib_dimn = symb.nrow - symb.ncol; - contrib_dimn = contrib_dimn*contrib_dimn; - contrib = (contrib_dimn>0) ? PATraits::allocate(pool_alloc_, contrib_dimn) - : nullptr; - } - - /** \brief Free space for contribution block (if allocated) */ - void free_contrib() { - if(!contrib) return; - size_t contrib_dimn = symb.nrow - symb.ncol; - contrib_dimn = contrib_dimn*contrib_dimn; - PATraits::deallocate(pool_alloc_, contrib, contrib_dimn); - contrib = nullptr; - } - - /** \brief Return leading dimension of node's lcol member. */ - size_t get_ldl() { - return align_lda(symb.nrow + ndelay_in); - } - -public: - /* Symbolic node associate with this one */ - SymbolicNode const& symb; - - /* Fixed data from analyse */ - NumericNode* first_child; // Pointer to our first child - NumericNode* next_child; // Pointer to parent's next child - - /* Data that changes during factorize */ - ipc_ ndelay_in; // Number of delays arising from children - ipc_ ndelay_out; // Number of delays arising to push into parent - ipc_ nelim; // Number of columns succesfully eliminated - T *lcol; // Pointer to start of factor data - ipc_ *perm; // Pointer to permutation - T *contrib; // Pointer to contribution block -private: - PoolAllocator pool_alloc_; // Our own version of pool allocator for freeing - // contrib -}; - -}}} /* namespaces galahad::ssids::cpu */ diff --git a/include/ssids_cpu_NumericSubtree.hxx b/include/ssids_cpu_NumericSubtree.hxx deleted file mode 100644 index 5abb860901..0000000000 --- a/include/ssids_cpu_NumericSubtree.hxx +++ /dev/null @@ -1,650 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 08:00 GMT - */ - -#pragma once - -#include -#include - -#include "ssids_routines.h" -#include "galahad_precision.h" -#include "ssids_cpu_cpu_iface.hxx" -#include "ssids_cpu_factor.hxx" -#include "ssids_cpu_BuddyAllocator.hxx" -#include "ssids_cpu_NumericNode.hxx" -#include "ssids_cpu_SymbolicSubtree.hxx" -#include "ssids_cpu_SmallLeafNumericSubtree.hxx" -#include "ssids_cpu_ThreadStats.hxx" - -namespace galahad { namespace ssids { namespace cpu { - -/** \brief Represents a submatrix (subtree) factorized on the CPU. - * - * \tparam posdef true for Cholesky factorization, false for indefinite LDL^T - * \tparam T underlying numerical type e.g. double - * \tparam PAGE_SIZE initial size to be used for thread Workspace - * \tparam FactorAllocator allocator to be used for factor storage. It must - * zero memory upon allocation (eg through calloc or memset). - * */ -template -class NumericSubtree { - typedef BuddyAllocator> PoolAllocator; - //typedef SimpleAlignedAllocator PoolAllocator; - typedef SmallLeafNumericSubtree SLNS; -public: - /* Delete copy constructors for safety re allocated memory */ - NumericSubtree(const NumericSubtree&) =delete; - NumericSubtree& operator=(const NumericSubtree&) =delete; - /** \brief Construct factors associated with specified symbolic subtree by - * performing factorization. - * \param symbolic_subtree symbolic factorization of subtree to factorize - * \param aval pointer to user's a value array (references entire matrix) - * \param scaling pointer to optional scaling vector to be applied - * (references entire matrix). No scaling applied if null. - * \param child_contrib array of pointers to contributions from child - * subtrees. Information to be extracted by call to Fortran routine - * galahad_ssids_contrib_get_data_double() or _single(). - * \param control user-supplied options controlling execution. - * \param stats collection of statistics for return to user. - */ - NumericSubtree( - SymbolicSubtree const& symbolic_subtree, - T const* aval, - T const* scaling, - void** child_contrib, - struct cpu_factor_control const& control, - ThreadStats& stats) - : symb_(symbolic_subtree), - factor_alloc_(symbolic_subtree.get_factor_mem_est(control.multiplier)), - pool_alloc_(symbolic_subtree.get_pool_size()), - small_leafs_(static_cast(::operator new[](symb_.small_leafs_.size()*sizeof(SLNS)))) - { - // If the body throws (e.g. bad_alloc from a vector), ~NumericSubtree does - // not run, so free the raw small_leafs_ storage on the way out. (A ctor - // function-try-block can't be used: its handler may not touch members.) - try { - /* Associate symbolic nodes to numeric ones; copy tree structure */ - nodes_.reserve(symbolic_subtree.nnodes_+1); - for(ipc_ ni=0; niidx] : nullptr; - auto* nc = symbolic_subtree[ni].next_child; - nodes_[ni].next_child = nc ? &nodes_[nc->idx] : nullptr; - } - - /* Allocate workspaces */ - int num_threads = omp_get_num_threads(); - std::vector thread_stats(num_threads); - std::vector work; - work.reserve(num_threads); - for(ipc_ i=0; i - (symb_[ni], nodes_[ni], control, - thread_stats[this_thread], work, - pool_alloc_); - if(thread_stats[this_thread].flag(m); - T *d = nodes_[ni].lcol + n*ldl; - for(ipc_ i=0; i(d[2*i+2]))) { -#else - std::isfinite(d[2*i+2])) { -#endif - // 1x1 pivot (or zero) - if(a11 == 0.0) { - // NB: If we reach this stage, control.action must be true. - stats.flag = Flag::WARNING_FACT_SINGULAR; - stats.num_zero++; - } - if(a11 < 0.0) stats.num_neg++; - i++; - } else { - // 2x2 pivot - T a22 = d[2*i+3]; - stats.num_two++; - T det = a11*a22 - a21*a21; // product of evals - T trace = a11 + a22; // sum of evals - if(det < 0) stats.num_neg++; - else if(trace < 0) stats.num_neg+=2; - i+=2; - } - } - } - } - } catch(...) { - ::operator delete[](small_leafs_); - throw; - } - } - ~NumericSubtree() { - // small_leafs_ is raw storage from ::operator new[]; elements are created - // with placement new. SLNS is trivially destructible so no per-element - // ~SLNS() loop is needed (and some slots may be unconstructed on abort); - // release the raw storage with the matching ::operator delete[]. - static_assert(std::is_trivially_destructible::value, - "SmallLeafNumericSubtree is no longer trivially destructible: " - "~NumericSubtree must destroy the constructed small_leafs_ elements"); - ::operator delete[](small_leafs_); - } - - void solve_fwd(ipc_ nrhs, T* x, ipc_ ldx) const { - /* Allocate memory (RAII: no leak if the second allocation throws) */ - std::unique_ptr xlocal_owner(new T[nrhs*symb_.n]); - T* xlocal = xlocal_owner.get(); - std::unique_ptr map_owner( - (!posdef) ? new ipc_[symb_.n] : nullptr); // only indef - ipc_* map_alloc = map_owner.get(); - - /* Main loop */ - for(ipc_ ni=0; ni(m+ndin); - - /* Build map (indef only) */ - ipc_ const *map; - if(!posdef) { - // indef need to allow for permutation and/or delays - for(ipc_ i=0; i m, just use beta=0 - // in dgemm call and then add as we scatter - for(ipc_ r=0; r - void solve_diag_bwd_inner(ipc_ nrhs, T* x, ipc_ ldx) const { - if(posdef && !do_bwd) return; // diagonal solve is a no-op for posdef - - /* Allocate memory - map only needed for indef bwd/diag_bwd solve. - * RAII: no leak if the second allocation throws. */ - std::unique_ptr xlocal_owner(new T[nrhs*symb_.n]); - T* xlocal = xlocal_owner.get(); - std::unique_ptr map_owner( - (!posdef && do_bwd) ? new ipc_[symb_.n] : nullptr); - ipc_* map_alloc = map_owner.get(); - - /* Perform solve */ - for(ipc_ ni=symb_.nnodes_-1; ni>=0; --ni) { - ipc_ m = symb_[ni].nrow; - ipc_ n = symb_[ni].ncol; - ipc_ nelim = (posdef) ? n - : nodes_[ni].nelim; - ipc_ ndin = (posdef) ? 0 - : nodes_[ni].ndelay_in; - - /* Build map (indef only) */ - ipc_ const *map; - if(!posdef) { - // indef need to allow for permutation and/or delays - if(do_bwd) { - for(ipc_ i=0; i(m+ndin); - for(ipc_ r=0; r(nrhs, x, ldx); - } - - void solve_diag_bwd(ipc_ nrhs, T* x, ipc_ ldx) const { - solve_diag_bwd_inner(nrhs, x, ldx); - } - - void solve_bwd(ipc_ nrhs, T* x, ipc_ ldx) const { - solve_diag_bwd_inner(nrhs, x, ldx); - } - - /** Returns information on diagonal entries and/or pivot order. - * Note that piv_order is only set in indefinite case. - * One of piv_order or d may be null in indefinite case. - */ - void enquire(ipc_ *piv_order, T* d) const { - if(posdef) { - for(ipc_ ni=0; ni(blkm); - for(ipc_ i=0; i(blkm); - ipc_ nelim = nodes_[ni].nelim; - T const* dptr = &nodes_[ni].lcol[blkn*ldl]; -// if (d) { -// printf("d01 = %.1f %.1f\n", dptr[0], dptr[1]); -// printf("d23 = %.1f %.1f\n", dptr[2], dptr[3]); -// printf("d45 = %.1f %.1f\n", dptr[4], dptr[5]); -// printf("d67 = %.1f %.1f\n", dptr[6], dptr[7]); -// } -// printf("ni = %i, nelim = %i\n", ni+1, nelim); -//printf(" print from ssids_cpu_NumericSubtree.hxx:\n"); - for(ipc_ i=0; i(dptr[2*i+2]))) { -#else - std::isfinite(dptr[2*i+2])) { -#endif - /* 1x1 pivot */ - if(piv_order) { - piv_order[nodes_[ni].perm[i]-1] = (piv++); -// printf(" 1x1 pivot order %d = %d\n", nodes_[ni].perm[i]-1, -// piv_order[nodes_[ni].perm[i]-1]); - } - if(d) { -// printf("in = %i d(1,1) = %.1f\n", 2*i+0, dptr[2*i+0]); -// printf("in = %i d(2,1) = %.1f\n", 2*i+1, dptr[2*i+1]); - *(d++) = dptr[2*i+0]; - *(d++) = 0.0; - } - i+=1; - } else { - /* 2x2 pivot */ - if(piv_order) { - piv_order[nodes_[ni].perm[i]-1] = -(piv++); -// printf(" 2x2 pivot order %d = %d\n", nodes_[ni].perm[i]-1, -// piv_order[nodes_[ni].perm[i]-1]); - piv_order[nodes_[ni].perm[i+1]-1] = -(piv++); -// printf(" 2x2 pivot order %d = %d\n", nodes_[ni].perm[i+1]-1, -// piv_order[nodes_[ni].perm[i+1]-1]); - } - if(d) { -// printf("in = %i d(1,1) = %.1f\n", 2*i+0, dptr[2*i+0]); -// printf("in = %i d(2,1) = %.1f\n", 2*i+1, dptr[2*i+1]); -// printf("in = %i d(1,2) = %.1f\n", 2*i+2, dptr[2*i+2]); -// printf("in = %i d(2,2) = %.1f\n", 2*i+3, dptr[2*i+3]); - *(d++) = dptr[2*i+0]; - *(d++) = dptr[2*i+1]; - *(d++) = dptr[2*i+3]; /* not 2*i+2 as stated ?? */ - *(d++) = 0.0; - } - i+=2; - } - } - - } -// printf("piv_order: "); -// for(ipc_ i=0; i<4; i++) { -// printf(" %d", piv_order[i]); -// } -// printf("\n"); - } - } - - /** Allows user to alter D values, indef case only. */ - void alter(T const* d) { - for(ipc_ ni=0; ni(blkm); - ipc_ nelim = nodes_[ni].nelim; - T* dptr = &nodes_[ni].lcol[blkn*ldl]; - - for(ipc_ i=0; i(dptr[2*i+2]))) { -#else - if(i+1==nelim || std::isfinite(dptr[2*i+2])) { -#endif - /* 1x1 pivot */ - dptr[2*i+0] = *(d++); - d++; /* bug fix - correct increment */ -// printf("in = %i d(1,1) = %.1f\n", 2*i+0, dptr[2*i+0]); - i+=1; - } else { - /* 2x2 pivot */ - dptr[2*i+0] = *(d++); - dptr[2*i+1] = *(d++); - dptr[2*i+3] = *(d++); - d++; /* bug fix - correct increment */ -// printf("in = %i d(1,1) = %.1f\n", 2*i+0, dptr[2*i+0]); -// printf("in = %i d(2,1) = %.1f\n", 2*i+1, dptr[2*i+1]); -// printf("in = %i d(1,2) = %.1f\n", 2*i+2, dptr[2*i+2]); -// printf("in = %i d(2,2) = %.1f\n", 2*i+3, dptr[2*i+3]); - i+=2; - } - } -// for(ipc_ i=0; i(m); - ipc_ nelim = nodes_[node].nelim; - ipc_ const* rlist = &symb_[node].rlist[ symb_[node].ncol ]; - for(ipc_ i=0; i0) ? &root.perm[root.nelim] - : nullptr; - lddelay = align_lda(root.symb.nrow + root.ndelay_in); - delay_val = (ndelay>0) ? &root.lcol[root.nelim*(lddelay+1)] - : nullptr; - } - - /** Frees root's contribution block */ - void free_contrib() { - nodes_.back().first_child->free_contrib(); - } - - SymbolicSubtree const& get_symbolic_subtree() { return symb_; } - -private: - SymbolicSubtree const& symb_; - FactorAllocator factor_alloc_; - PoolAllocator pool_alloc_; - std::vector> nodes_; - SLNS *small_leafs_; // Apparently emplace_back isn't threadsafe, so - // std::vector is out. So we use placement new instead. -}; - -}}} /* end of namespace galahad::ssids::cpu */ diff --git a/include/ssids_cpu_SmallLeafNumericSubtree.hxx b/include/ssids_cpu_SmallLeafNumericSubtree.hxx deleted file mode 100644 index 37ec06adf6..0000000000 --- a/include/ssids_cpu_SmallLeafNumericSubtree.hxx +++ /dev/null @@ -1,451 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 08:00 GMT - */ - -#pragma once - -#include - -#include "ssids_routines.h" -#include "galahad_precision.h" -#include "ssids_cpu_cpu_iface.hxx" -#include "ssids_cpu_factor.hxx" -#include "ssids_cpu_NumericNode.hxx" -#include "ssids_cpu_SmallLeafSymbolicSubtree.hxx" -#include "ssids_cpu_ThreadStats.hxx" - -/* SPRAL headers */ - -namespace galahad { namespace ssids { namespace cpu { - -template -class SmallLeafNumericSubtree; - -/// Positive-definite specialization -template -class SmallLeafNumericSubtree { - typedef typename std::allocator_traits::template rebind_traits FAPrecisionTraits; - typedef typename std::allocator_traits::template rebind_traits FAIntTraits; - typedef std::allocator_traits PATraits; -public: - SmallLeafNumericSubtree(SmallLeafSymbolicSubtree const& symb, std::vector>& old_nodes, T const* aval, T const* scaling, FactorAllocator& factor_alloc, PoolAllocator& pool_alloc, std::vector& work_vec, struct cpu_factor_control const& control, ThreadStats& stats) - : old_nodes_(old_nodes), symb_(symb), lcol_(FAPrecisionTraits::allocate(factor_alloc, symb.nfactor_)) - { - Workspace& work = work_vec[omp_get_thread_num()]; - /* Initialize nodes */ - for(ipc_ ni=symb_.sa_; ni<=symb_.en_; ++ni) { - old_nodes_[ni].ndelay_in = 0; - old_nodes_[ni].lcol = lcol_ + symb_[ni-symb_.sa_].lcol_offset; - } - memset(lcol_, 0, symb_.nfactor_*sizeof(T)); - - /* Add aval entries */ - for(ipc_ ni=symb_.sa_; ni<=symb_.en_; ++ni) - add_a(ni-symb_.sa_, symb_.symb_[ni], aval, scaling); - - /* Perform factorization */ - for(ipc_ ni=symb_.sa_; ni<=symb_.en_; ++ni) { - // Assembly - ipc_* map = work.get_ptr(symb_.symb_.n+1); - assemble - (ni-symb_.sa_, symb_.symb_[ni], &old_nodes_[ni], factor_alloc, - pool_alloc, map, aval, scaling); - // Update stats - ipc_ nrow = symb_.symb_[ni].nrow; - stats.maxfront = std::max(stats.maxfront, nrow); - ipc_ ncol = symb_.symb_[ni].ncol; - stats.maxsupernode = std::max(stats.maxsupernode, ncol); - // Factorization - rpc_ one_val = 1.0; - factor_node_posdef - (one_val, symb_.symb_[ni], old_nodes_[ni], control, stats); - if(stats.flag(snode.nrow); - if(scaling) { - /* Scaling to apply */ - for(ipc_ i=0; i* node, - FactorAllocator& factor_alloc, - PoolAllocator& pool_alloc, - ipc_* map, - T const* aval, - T const* scaling - ) { - /* Rebind allocators */ - typename FAIntTraits::allocator_type factor_alloc_int(factor_alloc); - - /* Count incoming delays and determine size of node */ - ipc_ nrow = snode.nrow; - ipc_ ncol = snode.ncol; - - /* Get space for contribution block + zero it */ - longc_ contrib_dimn = snode.nrow - snode.ncol; - node->contrib = (contrib_dimn > 0) ? PATraits::allocate(pool_alloc, - contrib_dimn*contrib_dimn) : nullptr; - if(node->contrib) - memset(node->contrib, 0, contrib_dimn*contrib_dimn*sizeof(T)); - - /* Alloc + set perm */ - node->perm = FAIntTraits::allocate(factor_alloc_int, ncol); // ncol fully summed variables - for(ipc_ i=0; iperm[i] = snode.rlist[i]; - - /* Add children */ - if(node->first_child != NULL) { - /* Build lookup vector, allowing for insertion of delayed vars */ - /* Note that while rlist[] is 1-indexed this is fine so long as lookup - * is also 1-indexed (which it is as it is another node's rlist[] */ - for(ipc_ i=0; ifirst_child; child!=NULL; child=child->next_child) { - SymbolicNode const& csnode = child->symb; - /* Handle expected contributions (only if something there) */ - if(child->contrib) { - ipc_ cm = csnode.nrow - csnode.ncol; - for(ipc_ i=0; icontrib[i*cm]; - if(c < snode.ncol) { - // Contribution added to lcol - ipc_ ldd = align_lda(nrow); - T *dest = &node->lcol[c*ldd]; - for(ipc_ j=i; jcontrib[(c-ncol)*ldd]; - for(ipc_ j=i; jfree_contrib(); - } - } - } -} - -private: - std::vector>& old_nodes_; - SmallLeafSymbolicSubtree const& symb_; - T* lcol_; -}; - -// Indefinite specialization -template -class SmallLeafNumericSubtree { - typedef typename std::allocator_traits::template rebind_traits FAPrecisionTraits; - typedef typename std::allocator_traits::template rebind_traits FAIntTraits; - typedef std::allocator_traits PATraits; -public: - SmallLeafNumericSubtree(SmallLeafSymbolicSubtree const& symb, std::vector>& old_nodes, T const* aval, T const* scaling, FactorAllocator& factor_alloc, PoolAllocator& pool_alloc, std::vector& work_vec, struct cpu_factor_control const& control, ThreadStats& stats) - : old_nodes_(old_nodes), symb_(symb) - { - Workspace& work = work_vec[omp_get_thread_num()]; - for(ipc_ ni=symb_.sa_; ni<=symb_.en_; ++ni) { - /*printf("%d: Node %d parent %d (of %d) size %d x %d\n", - omp_get_thread_num(), ni, symb_[ni].parent, symb_.nnodes_, - symb_[ni].nrow, symb_[ni].ncol);*/ - // Assembly of node (not of contribution block) - ipc_* map = work.get_ptr(symb_.symb_.n+1); - assemble_pre - (symb_.symb_[ni], old_nodes_[ni], factor_alloc, - pool_alloc, map, aval, scaling); - // Update stats - ipc_ nrow = symb_.symb_[ni].nrow + old_nodes_[ni].ndelay_in; - stats.maxfront = std::max(stats.maxfront, nrow); - ipc_ ncol = symb_.symb_[ni].ncol + old_nodes_[ni].ndelay_in; - stats.maxsupernode = std::max(stats.maxsupernode, ncol); - - // Factorization - factor_node - (symb_.symb_[ni], &old_nodes_[ni], control, - stats, work, pool_alloc); - if(stats.flag& node, - FactorAllocator& factor_alloc, - PoolAllocator& pool_alloc, - ipc_* map, - T const* aval, - T const* scaling - ) { - /* Rebind allocators */ - typename FAPrecisionTraits::allocator_type factor_alloc_precision(factor_alloc); - typename FAIntTraits::allocator_type factor_alloc_int(factor_alloc); - - /* Count incoming delays and determine size of node */ - node.ndelay_in = 0; - for(auto* child=node.first_child; child!=NULL; child=child->next_child) { - node.ndelay_in += child->ndelay_out; - } - ipc_ nrow = snode.nrow + node.ndelay_in; - ipc_ ncol = snode.ncol + node.ndelay_in; - - /* Get space for node now we know it size using Fortran allocator + zero it*/ - // NB L is nrow x ncol and D is 2 x ncol (but no D if posdef) - size_t ldl = align_lda(nrow); - size_t len = (ldl+2) * ncol; // +2 is for D - node.lcol = FAPrecisionTraits::allocate(factor_alloc_precision, len); - memset(node.lcol, 0, len*sizeof(T)); - - /* Get space for contribution block + (explicitly do not zero it!) */ - longc_ contrib_dimn = snode.nrow - snode.ncol; - node.contrib = (contrib_dimn > 0) ? PATraits::allocate(pool_alloc, contrib_dimn*contrib_dimn) : nullptr; - - /* Alloc + set perm for expected eliminations at this node (delays are set - * when they are imported from children) */ - node.perm = FAIntTraits::allocate(factor_alloc_int, ncol); // ncol fully summed variables - for(ipc_ i=0; i= snode.ncol) k += node.ndelay_in; - T rscale = scaling[ snode.rlist[r]-1 ]; - T cscale = scaling[ snode.rlist[c]-1 ]; - node.lcol[k] = rscale * aval[src] * cscale; - } - } else { - /* No scaling to apply */ - for(ipc_ i=0; i= snode.ncol) k += node.ndelay_in; - node.lcol[k] = aval[src]; - } - } - - /* Add children */ - if(node.first_child != NULL) { - /* Build lookup vector, allowing for insertion of delayed vars */ - /* Note that while rlist[] is 1-indexed this is fine so long as lookup - * is also 1-indexed (which it is as it is another node's rlist[] */ - for(ipc_ i=0; inext_child) { - SymbolicNode const& csnode = child->symb; - /* Handle delays - go to back of node - * (i.e. become the last rows as in lower triangular format) */ - for(ipc_ i=0; indelay_out; i++) { - // Add delayed rows (from delayed cols) - T *dest = &node.lcol[delay_col*(ldl+1)]; - ipc_ lds = align_lda(csnode.nrow + child->ndelay_in); - T *src = &child->lcol[(child->nelim+i)*(lds+1)]; - node.perm[delay_col] = child->perm[child->nelim+i]; - for(ipc_ j=0; jndelay_out-i; j++) { - dest[j] = src[j]; - } - // Add child's non-fully summed rows (from delayed cols) - dest = node.lcol; - src = &child->lcol[child->nelim*lds + child->ndelay_in +i*lds]; - for(ipc_ j=csnode.ncol; jcontrib) { - ipc_ cm = csnode.nrow - csnode.ncol; - for(ipc_ i=0; icontrib[i*cm]; - // NB: we handle contribution to contrib in assemble_post() - if(c < snode.ncol) { - // Contribution added to lcol - ipc_ ldd = align_lda(nrow); - T *dest = &node.lcol[c*ldd]; - for(ipc_ j=i; j* node, - struct cpu_factor_control const& control, - ThreadStats& stats, - Workspace& work, - PoolAllocator& pool_alloc - ) { - /* Extract useful information about node */ - ipc_ m = snode.nrow + node->ndelay_in; - ipc_ n = snode.ncol + node->ndelay_in; - size_t ldl = align_lda(m); - T *lcol = node->lcol; - T *d = &node->lcol[ n*ldl ]; - ipc_ *perm = node->perm; - - /* Perform factorization */ - T *ld = work.get_ptr(2*m); - node->nelim = ldlt_tpp_factor( - m, n, perm, lcol, ldl, d, ld, m, control.action, control.u, - control.small - ); - - if(m-n>0 && node->nelim>0) { - ipc_ nelim = node->nelim; - ipc_ ldld = align_lda(m-n); - T *ld = work.get_ptr(nelim*ldld); - calcLD(m-n, nelim, &lcol[n], ldl, d, ld, ldld); - host_gemm(OP_N, OP_T, m-n, m-n, nelim, - -1.0, &lcol[n], ldl, ld, ldld, - 0.0, node->contrib, m-n); - } - - /* Record information */ - node->ndelay_out = n - node->nelim; - stats.num_delay += node->ndelay_out; - for (longc_ j = m; j >= m-(node->nelim)+1; --j) { - stats.num_factor += j; - stats.num_flops += j*j; - } - - /* Mark as no contribution if we make no contribution */ - if(node->nelim==0 && !node->first_child) { - // FIXME: Actually loop over children and check one exists with contrib - // rather than current approach of just looking for children. - node->free_contrib(); - } else if(node->nelim==0) { - // FIXME: If we fix the above, we don't need this explict zeroing - longc_ contrib_size = m-n; - memset(node->contrib, 0, contrib_size*contrib_size*sizeof(T)); - } - } - - void assemble_post( - SymbolicNode const& snode, - NumericNode& node, - PoolAllocator& pool_alloc, - ipc_* map - ) { - /* Initialise variables */ - ipc_ ncol = snode.ncol + node.ndelay_in; - - /* Add children */ - if(node.first_child != NULL) { - /* Build lookup vector, allowing for insertion of delayed vars */ - /* Note that while rlist[] is 1-indexed this is fine so long as lookup - * is also 1-indexed (which it is as it is another node's rlist[] */ - for(ipc_ i=0; inext_child) { - SymbolicNode const& csnode = child->symb; - if(!child->contrib) continue; - ipc_ cm = csnode.nrow - csnode.ncol; - for(ipc_ i=0; icontrib[i*cm]; - // NB: only interested in contribution to generated element - if(c >= snode.ncol) { - // Contribution added to contrib - ipc_ ldd = snode.nrow - snode.ncol; - T *dest = &node.contrib[(c-ncol)*ldd]; - for(ipc_ j=i; jfree_contrib(); - } - } - } - - std::vector>& old_nodes_; - SmallLeafSymbolicSubtree const& symb_; -}; - -}}} /* namespaces galahad::ssids::cpu */ diff --git a/include/ssids_cpu_SmallLeafSymbolicSubtree.hxx b/include/ssids_cpu_SmallLeafSymbolicSubtree.hxx deleted file mode 100644 index 264696a6f0..0000000000 --- a/include/ssids_cpu_SmallLeafSymbolicSubtree.hxx +++ /dev/null @@ -1,141 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 08:00 GMT - */ - -#pragma once - -#include - -#include "ssids_routines.h" -#include "galahad_precision.h" -#include "ssids_cpu_cpu_iface.hxx" -#include "ssids_cpu_SymbolicNode.hxx" - -namespace galahad { namespace ssids { namespace cpu { - -class SymbolicSubtree; - -/** Handles the factorization of a small leaf subtree on a single core. - * - * This code uses supernodal working within the tree, and generates a - * multifrontal-style contribution block above the tree. The analyse phase - * generates internal data structures that guide the assembly process in an - * efficient fashion, aiming to maximize vectorization. - * - * It is expected that the subtree will fit within L2 cache exclusively owned - * by the executing thread. - */ -class SmallLeafSymbolicSubtree { -private: - class Node { - public: - ipc_ nrow; - ipc_ ncol; - ipc_ sparent; - ipc_* rlist; - ipc_ lcol_offset; - }; - -public: - /** - * \brief Constructor - * - * Perform work in the analyse phase of the solver. Set up data structures - * for fast numerical factorization. We are passed datastructures describing - * the whole tree, and consider the subtree composed of contigously numbered - * nodes sa:en. - * - * NB: The global tree is split into parts (parttrees), which then futher - * split themselves into small leaf subtrees like this. - * - * \param sa First (start) supernode in subtree, from start of containing - * parttree. - * \param en Last (end) supernode in subtree, from start of containing - * parttree. - * \param part_offset Offset of containing parttree into global tree. - * \param sptr Supernode pointers. Supernode i consists of columns - * sptr[i]:sptr[i+1]-1. Entries of sptr are numbered from 1 not 0. - * \param sparent Supernode parent list. Supernode i has parent sparent[i]. - * If sparent[i]>part_offset+en then it belongs to a parent subtree. - * Or is a virtual root if node i is square. - * \param rptr Row list pointers. Supernode i consists of rows - * row_list[rptr[i]-1:rptr[i+1]-1-1]. Note entries are numbered from 1 - * not 0. - * \param rlist Row lists. Supernode i consists of rows - * row_list[rptr[i]-1:rptr[i+1]-1-1]. Note entries are numbered from 1 - * not 0. - * \param nptr Node pointers for map from \f$ A \f$ to \f$ L \f$. Node i - * has map entries nlist[2*(nptr[i]-1):2*(nptr[i+1]-1-1)+1]. - * Note entries are numbered from 1 not 0. - * \param nlist Mapping from \f$ A \f$ to \f$ L \f$. Each map entry is a - * pair such that entry nlist[2*i+0] of \f$ A \f$ maps to entry - * nlist[2*i+1] of the relevant supernode (as per nptr) of \f$ L \f$. - * \param symb Underlying SymbolicSubtree for containing parttree. - */ - SmallLeafSymbolicSubtree(ipc_ sa, ipc_ en, ipc_ part_offset, - ipc_ const* sptr, ipc_ const* sparent, - longc_ const* rptr, ipc_ const* rlist, - longc_ const* nptr, longc_ const* nlist, - SymbolicSubtree const& symb) - : sa_(sa), en_(en), nnodes_(en-sa+1), - parent_(sparent[part_offset+en]-1-part_offset), nodes_(nnodes_), - rlist_(new ipc_[rptr[part_offset+en+1]-rptr[part_offset+sa]], - std::default_delete()), - nptr_(nptr), nlist_(nlist), symb_(symb) - { - /* Setup basic node information */ - nfactor_ = 0; - ipc_* newrlist = rlist_.get(); - for(ipc_ ni=sa; ni<=en; ++ni) { - nodes_[ni-sa].nrow = rptr[part_offset+ni+1] - rptr[part_offset+ni]; - nodes_[ni-sa].ncol = sptr[part_offset+ni+1] - sptr[part_offset+ni]; - nodes_[ni-sa].sparent = sparent[part_offset+ni]-sa-1; // sparent is Fortran indexed - // FIXME: subtract ncol off rlist for elim'd vars - nodes_[ni-sa].rlist = &newrlist[rptr[part_offset+ni]-rptr[part_offset+sa]]; - nodes_[ni-sa].lcol_offset = nfactor_; - size_t ldl = align_lda(nodes_[ni-sa].nrow); - nfactor_ += nodes_[ni-sa].ncol*ldl; - } - /* Construct rlist_ being offsets into parent node */ - for(ipc_ ni=sa; ni<=en; ++ni) { - if(nodes_[ni-sa].ncol == nodes_[ni-sa].nrow) continue; // is root - ipc_ const* ilist = &rlist[rptr[part_offset+ni]-1]; // rptr is Fortran indexed - ilist += nodes_[ni-sa].ncol; // Skip eliminated vars - ipc_ pnode = sparent[part_offset+ni]-1; //Fortran indexed - ipc_ const* jlist = &rlist[rptr[pnode]-1]; // rptr is Fortran indexed - ipc_ const* jstart = jlist; - ipc_ *outlist = nodes_[ni-sa].rlist; - for(ipc_ i=nodes_[ni-sa].ncol; i nodes_; //< Nodes of this subtree. - std::shared_ptr rlist_; //< Row entries of this subtree. - longc_ const* nptr_; //< Node mapping into nlist_. - longc_ const* nlist_; //< Mapping from \f$ A \f$ to \f$ L \f$. - SymbolicSubtree const& symb_; //< Underlying parttree - - template - friend class SmallLeafNumericSubtree; -}; - - -}}} /* namespaces galahad::ssids::cpu */ diff --git a/include/ssids_cpu_SymbolicNode.hxx b/include/ssids_cpu_SymbolicNode.hxx deleted file mode 100644 index 85724a4a71..0000000000 --- a/include/ssids_cpu_SymbolicNode.hxx +++ /dev/null @@ -1,30 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 08:00 GMT - */ -#pragma once - -#include -#include "ssids_routines.h" -#include "galahad_precision.h" - -namespace galahad { namespace ssids { namespace cpu { - -/** Symbolic representation of a node */ -struct SymbolicNode { - bool insmallleaf; - ipc_ idx; //< Index of node - ipc_ nrow; //< Number of rows - ipc_ ncol; //< Number of columns - SymbolicNode* first_child; //< Pointer to first child in linked list - SymbolicNode* next_child; //< Pointer to second child in linked list - ipc_ const* rlist; //< Pointer to row lists - ipc_ num_a; //< Number of entries mapped from A to L - longc_ const* amap; //< Pointer to map from A to L locations - ipc_ parent; //< index of parent node - std::vector contrib; //< index of expected contribution(s) -}; - -}}} /* end of namespace galahad::ssids::cpu */ diff --git a/include/ssids_cpu_SymbolicSubtree.hxx b/include/ssids_cpu_SymbolicSubtree.hxx deleted file mode 100644 index 08b3dc8dbb..0000000000 --- a/include/ssids_cpu_SymbolicSubtree.hxx +++ /dev/null @@ -1,119 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 08:00 GMT - */ -#pragma once - -#include -#include -#include - -#include "ssids_routines.h" -#include "galahad_precision.h" -#include "ssids_cpu_SmallLeafSymbolicSubtree.hxx" -#include "ssids_cpu_SymbolicNode.hxx" - -namespace galahad { namespace ssids { namespace cpu { - -/** Symbolic factorization of a subtree to be factored on the CPU */ -class SymbolicSubtree { -public: - SymbolicSubtree(ipc_ n, ipc_ sa, ipc_ en, ipc_ const* sptr, - ipc_ const* sparent, longc_ const* rptr, - ipc_ const* rlist, longc_ const* nptr, - longc_ const* nlist, ipc_ ncontrib, - ipc_ const* contrib_idx, - struct cpu_factor_control const& control) - : n(n), nnodes_(en-sa), nodes_(nnodes_+1) - { - // Adjust sa to C indexing (en is not used except in nnodes_ init above) - sa--; - // FIXME: don't process nodes that are in small leaf subtrees - /* Fill out basic details */ - maxfront_ = 0; - for(ipc_ ni=0; ni(rptr[sa+ni+1] - rptr[sa+ni]); - nodes_[ni].ncol = sptr[sa+ni+1] - sptr[sa+ni]; - nodes_[ni].first_child = nullptr; - nodes_[ni].next_child = nullptr; - nodes_[ni].rlist = &rlist[rptr[sa+ni]-1]; // rptr is Fortran indexed - nodes_[ni].num_a = nptr[sa+ni+1] - nptr[sa+ni]; - nodes_[ni].amap = &nlist[2*(nptr[sa+ni]-1)]; // nptr is Fortran indexed - nodes_[ni].parent = sparent[sa+ni]-sa-1; // sparent is Fortran indexed - nodes_[ni].insmallleaf = false; // default to not in small leaf subtree - maxfront_ = std::max(maxfront_, (size_t) nodes_[ni].nrow); - } - nodes_[nnodes_].first_child = nullptr; // List of roots - /* Build child linked lists */ - for(ipc_ ni=0; nifirst_child; - parent->first_child = &nodes_[ni]; - } - /* Record contribution block inputs */ - for(ipc_ ci=0; ci(nodes_[ni].nrow)*nodes_[ni].ncol; - /* Find small leaf subtrees */ - // Count flops below each node - std::vector flops(nnodes_+1, 0); - for(ipc_ ni=0; ni 0) // not a leaf! - flops[ni] += control.small_subtree_threshold; - ipc_ parent = std::min(nodes_[ni].parent, nnodes_); - flops[parent] += flops[ni]; - } - // Start at least node and work way up using parents until too large - for(ipc_ ni=0; ni= control.small_subtree_threshold) break; - last = current; - } - if(last==ni) { ++ni; continue; } // No point for a single node - // Nodes ni:last are in subtree - small_leafs_.emplace_back( - ni, last, sa, sptr, sparent, rptr, rlist, nptr, nlist, *this - ); - for(ipc_ i=ni; i<=last; ++i) - nodes_[i].insmallleaf = true; - ni = last+1; // Skip to next node not in this subtree - } - } - - SymbolicNode const& operator[](ipc_ idx) const { - return nodes_[idx]; - } - size_t get_factor_mem_est(rpc_ multiplier) const { - size_t mem = n*sizeof(ipc_) + (2*n+nfactor_)*sizeof(rpc_); - return std::max(mem, static_cast(mem*multiplier)); - } - template - size_t get_pool_size() const { - return maxfront_*align_lda(maxfront_); - } -public: - ipc_ const n; //< Maximum row index -private: - ipc_ nnodes_; - size_t nfactor_; - size_t maxfront_; - std::vector nodes_; - std::vector small_leafs_; - - template - friend class NumericSubtree; -}; - -}}} /* end of namespace galahad::ssids::cpu */ diff --git a/include/ssids_cpu_ThreadStats.hxx b/include/ssids_cpu_ThreadStats.hxx deleted file mode 100644 index 28ba27a63f..0000000000 --- a/include/ssids_cpu_ThreadStats.hxx +++ /dev/null @@ -1,69 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-19 AT 08:30 GMT - */ - -#pragma once - -#include -#include - -#include "ssids_routines.h" -#include "galahad_precision.h" - -namespace galahad { namespace ssids { namespace cpu { - -/** \brief SSIDS error/warning flags. - * - * Must match Fortran definitions in src/ssids/datatypes.f90 - */ -enum Flag : ipc_ { - SUCCESS = 0, - - ERROR_SINGULAR = -5, - ERROR_NOT_POS_DEF = -6, - ERROR_ALLOCATION = -50, - - WARNING_FACT_SINGULAR = 7 -}; - -/** - * \brief Exception class for control.action = false and singular matrix. - */ -class SingularError: public std::runtime_error { -public: - SingularError(ipc_ col) - : std::runtime_error("Matrix is singular"), col(col) - {} - - ipc_ const col; -}; - -/** - * \brief Factorization statistics for a thread. - * - * Defines a sensible set of initializations and other useful operations such - * as "summation" for condensing multiple threads' stats at the end of - * factorization. Interoperates with Fortran type cpu_factor_stats. - * - * \sa galahad_ssids_cpu_iface::cpu_factor_stats - */ -struct ThreadStats { - Flag flag = Flag::SUCCESS; ///< Error flag for thread - ipc_ num_delay = 0; ///< Number of delays - longc_ num_factor = 0; ///< Number of entries in factors - longc_ num_flops = 0; ///< Number of floating point operations - ipc_ num_neg = 0; ///< Number of negative pivots - ipc_ num_two = 0; ///< Number of 2x2 pivots - ipc_ num_zero = 0; ///< Number of zero pivots - ipc_ maxfront = 0; ///< Maximum front size - ipc_ maxsupernode = 0; ///< Maximum supernode size - ipc_ not_first_pass = 0; ///< Number of pivots not eliminated in APP - ipc_ not_second_pass = 0; ///< Number of pivots not eliminated in APP or TPP - - ThreadStats& operator+=(ThreadStats const& other); -}; - -}}} /* namespaces galahad::ssids::cpu */ diff --git a/include/ssids_cpu_Workspace.hxx b/include/ssids_cpu_Workspace.hxx deleted file mode 100644 index 591934b2bc..0000000000 --- a/include/ssids_cpu_Workspace.hxx +++ /dev/null @@ -1,81 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 08:00 GMT - */ - -#pragma once - -#include - -#include "ssids_routines.h" -#include "galahad_precision.h" -#include "ssids_compat.hxx" // in case std::align not defined - -namespace galahad { namespace ssids { namespace cpu { - -/** A Workspace is a chunk of memory that can be reused. The get_ptr(len) - * function provides a pointer to it after ensuring it is of at least the - * given size. */ -class Workspace { -#if defined(__AVX512F__) - static ipc_ const align = 64; -#elif defined(__AVX__) - static ipc_ const align = 32; -#else - static ipc_ const align = 16; -#endif -public: - Workspace(size_t sz) - { - alloc_and_align(sz); - } - // Owns a raw allocation, so is non-copyable (a shallow copy would double-free - // mem_ / leak the target's mem_); movable by stealing the allocation. - Workspace(Workspace const&) = delete; - Workspace& operator=(Workspace const&) = delete; - Workspace(Workspace&& other) noexcept - : mem_(other.mem_), mem_aligned_(other.mem_aligned_), sz_(other.sz_) - { - other.mem_ = nullptr; - other.mem_aligned_ = nullptr; - other.sz_ = 0; - } - Workspace& operator=(Workspace&& other) noexcept { - if(this != &other) { - ::operator delete(mem_); - mem_ = other.mem_; - mem_aligned_ = other.mem_aligned_; - sz_ = other.sz_; - other.mem_ = nullptr; - other.mem_aligned_ = nullptr; - other.sz_ = 0; - } - return *this; - } - ~Workspace() { - ::operator delete(mem_); - } - void alloc_and_align(size_t sz) { - sz_ = sz+align; - mem_ = ::operator new(sz_); - mem_aligned_ = mem_; - if(!std::align(align, sz, mem_aligned_, sz_)) throw std::bad_alloc(); - } - template - T* get_ptr(size_t len) { - if(sz_ < len*sizeof(T)) { - // Need to resize - ::operator delete(mem_); - alloc_and_align(len*sizeof(T)); - } - return static_cast(mem_aligned_); - } -private: - void* mem_; - void* mem_aligned_; - size_t sz_; -}; - -}}} /* end of namespace galahad::ssids::cpu */ diff --git a/include/ssids_cpu_cpu_iface.hxx b/include/ssids_cpu_cpu_iface.hxx deleted file mode 100644 index 277d011d01..0000000000 --- a/include/ssids_cpu_cpu_iface.hxx +++ /dev/null @@ -1,55 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 09:00 GMT - */ - -#pragma once - -#include - -#include "ssids_routines.h" -#include "galahad_precision.h" - -namespace galahad { namespace ssids { namespace cpu { - -enum struct PivotMethod : ipc_ { - app_aggressive = 1, - app_block = 2, - tpp = 3 -}; - -enum struct FailedPivotMethod : ipc_ { - tpp = 1, - pass = 2 -}; - -struct cpu_factor_control { - ipc_ print_level; - bool action; - rpc_ small; - rpc_ u; - rpc_ multiplier; - longc_ small_subtree_threshold; - ipc_ cpu_block_size; - PivotMethod pivot_method; - FailedPivotMethod failed_pivot_method; -}; - -/** Return nearest value greater than supplied lda that is multiple of alignment */ -template -size_t align_lda(size_t lda) { -#if defined(__AVX512F__) - ipc_ const align = 64; -#elif defined(__AVX__) - ipc_ const align = 32; -#else - ipc_ const align = 16; -#endif - static_assert(align % sizeof(T) == 0, "Can only align if T divides align"); - ipc_ const Talign = align / sizeof(T); - return Talign*((lda-1)/Talign + 1); -} - -}}} /* namespaces galahad::ssids::cpu */ diff --git a/include/ssids_cpu_factor.hxx b/include/ssids_cpu_factor.hxx deleted file mode 100644 index 30ccbe773a..0000000000 --- a/include/ssids_cpu_factor.hxx +++ /dev/null @@ -1,178 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 09:00 GMT - */ -#pragma once - -/* Standard headers */ -#include -#include -#include -#include - -#ifdef _OPENMP -#include -#endif /* _OPENMP */ - -/* SPRAL headers */ - -#include "ssids_routines.h" -#include "galahad_precision.h" -#include "ssids_cpu_cpu_iface.hxx" -#include "ssids_cpu_SymbolicNode.hxx" -#include "ssids_cpu_ThreadStats.hxx" -#include "ssids_cpu_Workspace.hxx" -#include "ssids_cpu_kernels_assemble.hxx" -#include "ssids_cpu_kernels_calc_ld.hxx" -#include "ssids_cpu_kernels_cholesky.hxx" -#include "ssids_cpu_kernels_ldlt_app.hxx" -#include "ssids_cpu_kernels_ldlt_tpp.hxx" -#include "ssids_cpu_kernels_wrappers.hxx" - -//#include "ssids_cpu_kernels_verify.hxx" // FIXME: remove debug - -namespace galahad { namespace ssids { namespace cpu { - -/* Factorize a node (indef) */ -template -void factor_node_indef( - SymbolicNode const& snode, - NumericNode &node, - struct cpu_factor_control const& control, - ThreadStats& stats, - std::vector& work, - PoolAlloc& pool_alloc - ) { - /* Extract useful information about node */ - ipc_ m = snode.nrow + node.ndelay_in; - ipc_ n = snode.ncol + node.ndelay_in; - size_t ldl = align_lda(m); - T *lcol = node.lcol; - T *d = &node.lcol[ n*ldl ]; - ipc_ *perm = node.perm; - T *contrib = node.contrib; - - /* Perform factorization */ - if(control.pivot_method != PivotMethod::tpp) { - // Use an APP based pivot method - T zero_val = 0.0; - node.nelim = ldlt_app_factor( - m, n, perm, lcol, ldl, d, zero_val, contrib, m-n, control, work, - pool_alloc - ); - if(node.nelim < 0) { - stats.flag = static_cast(node.nelim); - return; - } - } else { - // Otherwise, force use of TPP - node.nelim = 0; - } -//printf("past\n"); - /* Finish factorization worth simplistic code */ - if(node.nelim < n) { - ipc_ nelim = node.nelim; - if(control.pivot_method!=PivotMethod::tpp) - stats.not_first_pass += n-nelim; - // Only use TPP to finish off if we're a root node, it's not finishing - // off but actually doing it, or failed_pivot_method says to do so - if(m==n || control.pivot_method==PivotMethod::tpp || - control.failed_pivot_method==FailedPivotMethod::tpp) { - T *ld = work[omp_get_thread_num()].get_ptr(2*(m-nelim)); - node.nelim += ldlt_tpp_factor( - m-nelim, n-nelim, &perm[nelim], &lcol[nelim*(ldl+1)], ldl, - &d[2*nelim], ld, m-nelim, control.action, control.u, - control.small, nelim, &lcol[nelim], ldl - ); - if(m-n>0 && node.nelim>nelim) { - ipc_ nelim2 = node.nelim - nelim; - ipc_ ldld = align_lda(m-n); - T *ld = work[omp_get_thread_num()].get_ptr(nelim2*ldld); - calcLD( - m-n, nelim2, &lcol[nelim*ldl+n], ldl, &d[2*nelim], ld, ldld - ); - T rbeta = (nelim==0) ? 0.0 : 1.0; - host_gemm(OP_N, OP_T, m-n, m-n, nelim2, - -1.0, &lcol[nelim*ldl+n], ldl, ld, ldld, - rbeta, node.contrib, m-n); - } - if(control.pivot_method==PivotMethod::tpp) { - stats.not_first_pass += n - node.nelim; - } else { - stats.not_second_pass += n - node.nelim; - } - } - } - - /* Record information */ - node.ndelay_out = n - node.nelim; - stats.num_delay += node.ndelay_out; - for (longc_ j = m; j >= m-(node.nelim)+1; --j) { - stats.num_factor += j; - stats.num_flops += j*j; - } - - /* Mark as no contribution if we make no contribution */ - if(node.nelim==0 && !node.first_child && snode.contrib.size()==0) { - // FIXME: Actually loop over children and check one exists with contrib - // rather than current approach of just looking for children. - node.free_contrib(); - } else if(node.nelim==0) { - // FIXME: If we fix the above, we don't need this explict zeroing - longc_ contrib_size = m-n; - memset(node.contrib, 0, contrib_size*contrib_size*sizeof(T)); - } -} -/* Factorize a node (posdef) */ -template -void factor_node_posdef( - T beta, - SymbolicNode const& snode, - NumericNode &node, - struct cpu_factor_control const& control, - ThreadStats& stats - ) { - /* Extract useful information about node */ - ipc_ m = snode.nrow; - ipc_ n = snode.ncol; - ipc_ ldl = align_lda(m); - T *lcol = node.lcol; - T *contrib = node.contrib; - - /* Perform factorization */ - ipc_ flag; - cholesky_factor( - m, n, lcol, ldl, beta, contrib, m-n, control.cpu_block_size, &flag - ); - if(flag!=-1) { - node.nelim = flag+1; - stats.flag = Flag::ERROR_NOT_POS_DEF; - return; - } - node.nelim = n; - - /* Record information */ - node.ndelay_out = 0; - for (longc_ j = m; j >= m-(node.nelim)+1; --j) { - stats.num_factor += j; - stats.num_flops += j*j; - } -} -/* Factorize a node (wrapper) */ -template -void factor_node( - SymbolicNode const& snode, - NumericNode &node, - struct cpu_factor_control const& control, - ThreadStats& stats, - std::vector& work, - PoolAlloc& pool_alloc - ) { - T zero_val = 0.0; - if(posdef) factor_node_posdef(zero_val, snode, node, control, stats); - else factor_node_indef(snode, node, control, stats, work, pool_alloc); -} - -}}} /* end of namespace galahad::ssids::cpu */ diff --git a/include/ssids_cpu_kernels_SimdVec.hxx b/include/ssids_cpu_kernels_SimdVec.hxx deleted file mode 100644 index 4d0c12bc34..0000000000 --- a/include/ssids_cpu_kernels_SimdVec.hxx +++ /dev/null @@ -1,815 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 08:00 GMT - */ - -#pragma once - -#include -#include -#include - -#ifdef REAL_128 -#include -#endif - -#include "ssids_routines.h" -#include "galahad_precision.h" - -#if defined(__AVX2__) || defined(__AVX__) -#include -#endif - -namespace galahad { namespace ssids { namespace cpu { - -/** \brief The SimdVec class isolates use of AVX/whatever intrinsics in a - * single place for ease of upgrading to future instruction sets. - * - * Support is only added as required, so don't expect all intrinsics to be - * wrapped yet! */ - -#ifdef REAL_32 /* float version */ - -template -class SimdVec; - -template <> -class SimdVec { -public: - /******************************************* - * Properties of the type - *******************************************/ - -#if defined(__AVX2__) || defined(__AVX__) - /// Length of underlying vector type - static const ipc_ vector_length = 4; /* this should probably be 8 !! */ - /// Typedef for underlying vector type containing singles - typedef __m256 simd_precision_type; -#else - /// Length of underlying vector type - static const ipc_ vector_length = 1; - /// Typedef for underlying vector type containing floats - typedef float simd_precision_type; -#endif - - /******************************************* - * Constructors - *******************************************/ - - /// Uninitialized value constructor - SimdVec() - {} - /// Initialize all entries in vector to given scalar value - SimdVec(const float initial_value) - { -#if defined(__AVX2__) || defined(__AVX__) - val = _mm256_set1_pd(initial_value); -#else - val = initial_value; -#endif - } -#if defined(__AVX2__) || defined(__AVX__) - /// Initialize with underlying vector type - SimdVec(const simd_precision_type &initial_value) { - val = initial_value; - } -#endif - /// Initialize with another SimdVec - SimdVec(const SimdVec &initial_value) { - val = initial_value.val; - } -#if defined(__AVX2__) || defined(__AVX__) - /// Initialize as a vector by specifying all entries (no version for non-avx) - SimdVec(float x1, float x2, float x3, float x4) { - val = _mm256_set_pd(x4, x3, x2, x1); // Reversed order expected - } -#endif - - /******************************************* - * Memory load/store - *******************************************/ - - /// Load from suitably aligned memory - static - const SimdVec load_aligned(const float *src) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( _mm256_load_pd(src) ); -#else - return SimdVec( src[0] ); -#endif - } - - /// Load from unaligned memory - static - const SimdVec load_unaligned(const float *src) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( _mm256_loadu_pd(src) ); -#else - return SimdVec( src[0] ); -#endif - } - - /// Extract value as array - void store_aligned(float *dest) const { -#if defined(__AVX2__) || defined(__AVX__) - _mm256_store_pd(dest, val); -#else - dest[0] = val; -#endif - } - - /// Extract value as array - void store_unaligned(float *dest) const { -#if defined(__AVX2__) || defined(__AVX__) - _mm256_storeu_pd(dest, val); -#else - dest[0] = val; -#endif - } - - /******************************************* - * Named operations - *******************************************/ - - /// Blend operation: returns (mask) ? x2 : x1 - friend - SimdVec blend(const SimdVec &x1, const SimdVec &x2, const SimdVec &mask) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( _mm256_blendv_pd(x1.val, x2.val, mask.val) ); -#else - return SimdVec( (mask.val) ? x2 : x1 ); -#endif - } - - /// Returns absolute values - friend - SimdVec fabs(const SimdVec &x) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( - _mm256_andnot_pd(_mm256_set1_pd(-0.0), x) - ); -#else - return SimdVec( fabs(x.val) ); -#endif - } - - /// Return a = b * c + a - friend - SimdVec fmadd(const SimdVec &a, const SimdVec &b, const SimdVec &c) { -#if defined(__AVX2__) - return SimdVec( - _mm256_fmadd_pd(b.val, c.val, a.val) - ); -#else - return b*c + a; -#endif - } - - /******************************************* - * Operators - *******************************************/ - - /// Conversion to underlying type - operator simd_precision_type() const { - return val; - } - - /// Extract indvidual elements of vector (messy and inefficient) - /// idx MUST be < vector_length. - float operator[](size_t idx) const { - float -#if defined(__AVX512F__) - __attribute__((aligned(64))) -#elif defined(__AVX__) - __attribute__((aligned(32))) -#else - __attribute__((aligned(16))) -#endif - val_as_array[vector_length]; - store_aligned(val_as_array); - return val_as_array[idx]; - } - - /// Vector valued GT comparison - friend - SimdVec operator>(const SimdVec &lhs, const SimdVec &rhs) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( _mm256_cmp_pd(lhs.val, rhs.val, _CMP_GT_OQ) ); -#else - return SimdVec( lhs.val > rhs.val ); -#endif - } - - /// Bitwise and - friend - SimdVec operator&(const SimdVec &lhs, const SimdVec &rhs) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( _mm256_and_pd(lhs.val, rhs.val) ); -#else - return SimdVec( lhs.val && rhs.val ); -#endif - } - - /// Multiply - // NB: don't override builtin operator*(float,float) in scalar case -#if defined(__AVX2__) || defined(__AVX__) - friend - SimdVec operator*(const SimdVec &lhs, const SimdVec &rhs) { - return SimdVec( _mm256_mul_pd(lhs.val, rhs.val) ); - } -#endif - - SimdVec& operator*=(const SimdVec &rhs) { - *this = *this * rhs; - return *this; - } - - /// Add - // NB: don't override builtin operator*(float,float) in scalar case -#if defined(__AVX2__) || defined(__AVX__) - friend - SimdVec operator+(const SimdVec &lhs, const SimdVec &rhs) { - return SimdVec( _mm256_add_pd(lhs.val, rhs.val) ); - } -#endif - - /******************************************* - * Factory functions for special cases - *******************************************/ - - /// Returns an instance initialized to zero using custom instructions - static - SimdVec zero() { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec(_mm256_setzero_pd()); -#else - return SimdVec(0.0); -#endif - } - - /// Returns a vector with all positions idx or above set to true, otherwise - /// false. - static - SimdVec gt_mask(ipc_ idx) { -#if defined(__AVX2__) || defined(__AVX__) - const float avx_true = -std::numeric_limits::quiet_NaN(); - const float avx_false = 0.0; - switch(idx) { - case 0: return SimdVec(avx_true, avx_true, avx_true, avx_true); - case 1: return SimdVec(avx_false, avx_true, avx_true, avx_true); - case 2: return SimdVec(avx_false, avx_false, avx_true, avx_true); - case 3: return SimdVec(avx_false, avx_false, avx_false, avx_true); - default: return SimdVec(avx_false, avx_false, avx_false, avx_false); - } -#else - return (idx>0) ? SimdVec(false) : SimdVec(true); -#endif - } - - /******************************************* - * Debug functions - *******************************************/ - - /// Prints the vector (inefficient, use for debug only) - void print() { - for(ipc_ i=0; i -class SimdVec; - -template <> -class SimdVec<__float128> { -public: - /******************************************* - * Properties of the type - *******************************************/ - -#if defined(__AVX2__) || defined(__AVX__) - /// Length of underlying vector type - static const ipc_ vector_length = 4; /* this should probably be 8 !! */ - /// Typedef for underlying vector type containing singles - typedef __m256 simd_precision_type; -#else - /// Length of underlying vector type - static const ipc_ vector_length = 1; - /// Typedef for underlying vector type containing __float128s - typedef __float128 simd_precision_type; -#endif - - /******************************************* - * Constructors - *******************************************/ - - /// Uninitialized value constructor - SimdVec() - {} - /// Initialize all entries in vector to given scalar value - SimdVec(const __float128 initial_value) - { -#if defined(__AVX2__) || defined(__AVX__) - val = _mm256_set1_pd(initial_value); -#else - val = initial_value; -#endif - } -#if defined(__AVX2__) || defined(__AVX__) - /// Initialize with underlying vector type - SimdVec(const simd_precision_type &initial_value) { - val = initial_value; - } -#endif - /// Initialize with another SimdVec - SimdVec(const SimdVec<__float128> &initial_value) { - val = initial_value.val; - } -#if defined(__AVX2__) || defined(__AVX__) - /// Initialize as a vector by specifying all entries (no version for non-avx) - SimdVec(__float128 x1, __float128 x2, __float128 x3, __float128 x4) { - val = _mm256_set_pd(x4, x3, x2, x1); // Reversed order expected - } -#endif - - /******************************************* - * Memory load/store - *******************************************/ - - /// Load from suitably aligned memory - static - const SimdVec load_aligned(const __float128 *src) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( _mm256_load_pd(src) ); -#else - return SimdVec( src[0] ); -#endif - } - - /// Load from unaligned memory - static - const SimdVec load_unaligned(const __float128 *src) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( _mm256_loadu_pd(src) ); -#else - return SimdVec( src[0] ); -#endif - } - - /// Extract value as array - void store_aligned(__float128 *dest) const { -#if defined(__AVX2__) || defined(__AVX__) - _mm256_store_pd(dest, val); -#else - dest[0] = val; -#endif - } - - /// Extract value as array - void store_unaligned(__float128 *dest) const { -#if defined(__AVX2__) || defined(__AVX__) - _mm256_storeu_pd(dest, val); -#else - dest[0] = val; -#endif - } - - /******************************************* - * Named operations - *******************************************/ - - /// Blend operation: returns (mask) ? x2 : x1 - friend - SimdVec blend(const SimdVec &x1, const SimdVec &x2, const SimdVec &mask) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( _mm256_blendv_pd(x1.val, x2.val, mask.val) ); -#else - return SimdVec( (mask.val) ? x2 : x1 ); -#endif - } - - /// Returns absolute values - friend - SimdVec fabs(const SimdVec &x) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( - _mm256_andnot_pd(_mm256_set1_pd(-0.0), x) - ); -#else - return SimdVec( fabs(x.val) ); -#endif - } - - /// Return a = b * c + a - friend - SimdVec fmadd(const SimdVec &a, const SimdVec &b, const SimdVec &c) { -#if defined(__AVX2__) - return SimdVec( - _mm256_fmadd_pd(b.val, c.val, a.val) - ); -#else - return b*c + a; -#endif - } - - /******************************************* - * Operators - *******************************************/ - - /// Conversion to underlying type - operator simd_precision_type() const { - return val; - } - - /// Extract indvidual elements of vector (messy and inefficient) - /// idx MUST be < vector_length. - __float128 operator[](size_t idx) const { - __float128 -#if defined(__AVX512F__) - __attribute__((aligned(64))) -#elif defined(__AVX__) - __attribute__((aligned(32))) -#else - __attribute__((aligned(16))) -#endif - val_as_array[vector_length]; - store_aligned(val_as_array); - return val_as_array[idx]; - } - - /// Vector valued GT comparison - friend - SimdVec operator>(const SimdVec &lhs, const SimdVec &rhs) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( _mm256_cmp_pd(lhs.val, rhs.val, _CMP_GT_OQ) ); -#else - return SimdVec( lhs.val > rhs.val ); -#endif - } - - /// Bitwise and - friend - SimdVec operator&(const SimdVec &lhs, const SimdVec &rhs) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( _mm256_and_pd(lhs.val, rhs.val) ); -#else - return SimdVec( lhs.val && rhs.val ); -#endif - } - - /// Multiply - // NB: don't override builtin operator*(__float128,float) in scalar case -#if defined(__AVX2__) || defined(__AVX__) - friend - SimdVec operator*(const SimdVec &lhs, const SimdVec &rhs) { - return SimdVec( _mm256_mul_pd(lhs.val, rhs.val) ); - } -#endif - - SimdVec& operator*=(const SimdVec &rhs) { - *this = *this * rhs; - return *this; - } - - /// Add - // NB: don't override builtin operator*(float,float) in scalar case -#if defined(__AVX2__) || defined(__AVX__) - friend - SimdVec operator+(const SimdVec &lhs, const SimdVec &rhs) { - return SimdVec( _mm256_add_pd(lhs.val, rhs.val) ); - } -#endif - - /******************************************* - * Factory functions for special cases - *******************************************/ - - /// Returns an instance initialized to zero using custom instructions - static - SimdVec zero() { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec(_mm256_setzero_pd()); -#else - return SimdVec(0.0); -#endif - } - - /// Returns a vector with all positions idx or above set to true, otherwise - /// false. - static - SimdVec gt_mask(ipc_ idx) { -#if defined(__AVX2__) || defined(__AVX__) - const float avx_true = -std::numeric_limits::quiet_NaN(); - const float avx_false = 0.0; - switch(idx) { - case 0: return SimdVec(avx_true, avx_true, avx_true, avx_true); - case 1: return SimdVec(avx_false, avx_true, avx_true, avx_true); - case 2: return SimdVec(avx_false, avx_false, avx_true, avx_true); - case 3: return SimdVec(avx_false, avx_false, avx_false, avx_true); - default: return SimdVec(avx_false, avx_false, avx_false, avx_false); - } -#else - return (idx>0) ? SimdVec(false) : SimdVec(true); -#endif - } - - /******************************************* - * Debug functions - *******************************************/ - - /// Prints the vector (inefficient, use for debug only) - void print() { - for(ipc_ i=0; i -class SimdVec; - -template <> -class SimdVec { -public: - /******************************************* - * Properties of the type - *******************************************/ - -#if defined(__AVX2__) || defined(__AVX__) - /// Length of underlying vector type - static const ipc_ vector_length = 4; - /// Typedef for underlying vector type containing doubles - typedef __m256d simd_precision_type; -#else - /// Length of underlying vector type - static const ipc_ vector_length = 1; - /// Typedef for underlying vector type containing doubles - typedef double simd_precision_type; -#endif - - /******************************************* - * Constructors - *******************************************/ - - /// Uninitialized value constructor - SimdVec() - {} - /// Initialize all entries in vector to given scalar value - SimdVec(const double initial_value) - { -#if defined(__AVX2__) || defined(__AVX__) - val = _mm256_set1_pd(initial_value); -#else - val = initial_value; -#endif - } -#if defined(__AVX2__) || defined(__AVX__) - /// Initialize with underlying vector type - SimdVec(const simd_precision_type &initial_value) { - val = initial_value; - } -#endif - /// Initialize with another SimdVec - SimdVec(const SimdVec &initial_value) { - val = initial_value.val; - } -#if defined(__AVX2__) || defined(__AVX__) - /// Initialize as a vector by specifying all entries (no version for non-avx) - SimdVec(double x1, double x2, double x3, double x4) { - val = _mm256_set_pd(x4, x3, x2, x1); // Reversed order expected - } -#endif - - /******************************************* - * Memory load/store - *******************************************/ - - /// Load from suitably aligned memory - static - const SimdVec load_aligned(const double *src) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( _mm256_load_pd(src) ); -#else - return SimdVec( src[0] ); -#endif - } - - /// Load from unaligned memory - static - const SimdVec load_unaligned(const double *src) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( _mm256_loadu_pd(src) ); -#else - return SimdVec( src[0] ); -#endif - } - - /// Extract value as array - void store_aligned(double *dest) const { -#if defined(__AVX2__) || defined(__AVX__) - _mm256_store_pd(dest, val); -#else - dest[0] = val; -#endif - } - - /// Extract value as array - void store_unaligned(double *dest) const { -#if defined(__AVX2__) || defined(__AVX__) - _mm256_storeu_pd(dest, val); -#else - dest[0] = val; -#endif - } - - /******************************************* - * Named operations - *******************************************/ - - /// Blend operation: returns (mask) ? x2 : x1 - friend - SimdVec blend(const SimdVec &x1, const SimdVec &x2, const SimdVec &mask) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( _mm256_blendv_pd(x1.val, x2.val, mask.val) ); -#else - return SimdVec( (mask.val) ? x2 : x1 ); -#endif - } - - /// Returns absolute values - friend - SimdVec fabs(const SimdVec &x) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( - _mm256_andnot_pd(_mm256_set1_pd(-0.0), x) - ); -#else - return SimdVec( fabs(x.val) ); -#endif - } - - /// Return a = b * c + a - friend - SimdVec fmadd(const SimdVec &a, const SimdVec &b, const SimdVec &c) { -#if defined(__AVX2__) - return SimdVec( - _mm256_fmadd_pd(b.val, c.val, a.val) - ); -#else - return b*c + a; -#endif - } - - /******************************************* - * Operators - *******************************************/ - - /// Conversion to underlying type - operator simd_precision_type() const { - return val; - } - - /// Extract indvidual elements of vector (messy and inefficient) - /// idx MUST be < vector_length. - double operator[](size_t idx) const { - double -#if defined(__AVX512F__) - __attribute__((aligned(64))) -#elif defined(__AVX__) - __attribute__((aligned(32))) -#else - __attribute__((aligned(16))) -#endif - val_as_array[vector_length]; - store_aligned(val_as_array); - return val_as_array[idx]; - } - - /// Vector valued GT comparison - friend - SimdVec operator>(const SimdVec &lhs, const SimdVec &rhs) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( _mm256_cmp_pd(lhs.val, rhs.val, _CMP_GT_OQ) ); -#else - return SimdVec( lhs.val > rhs.val ); -#endif - } - - /// Bitwise and - friend - SimdVec operator&(const SimdVec &lhs, const SimdVec &rhs) { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec( _mm256_and_pd(lhs.val, rhs.val) ); -#else - return SimdVec( lhs.val && rhs.val ); -#endif - } - - /// Multiply - // NB: don't override builtin operator*(double,double) in scalar case -#if defined(__AVX2__) || defined(__AVX__) - friend - SimdVec operator*(const SimdVec &lhs, const SimdVec &rhs) { - return SimdVec( _mm256_mul_pd(lhs.val, rhs.val) ); - } -#endif - - SimdVec& operator*=(const SimdVec &rhs) { - *this = *this * rhs; - return *this; - } - - /// Add - // NB: don't override builtin operator*(double,double) in scalar case -#if defined(__AVX2__) || defined(__AVX__) - friend - SimdVec operator+(const SimdVec &lhs, const SimdVec &rhs) { - return SimdVec( _mm256_add_pd(lhs.val, rhs.val) ); - } -#endif - - /******************************************* - * Factory functions for special cases - *******************************************/ - - /// Returns an instance initialized to zero using custom instructions - static - SimdVec zero() { -#if defined(__AVX2__) || defined(__AVX__) - return SimdVec(_mm256_setzero_pd()); -#else - return SimdVec(0.0); -#endif - } - - /// Returns a vector with all positions idx or above set to true, otherwise - /// false. - static - SimdVec gt_mask(ipc_ idx) { -#if defined(__AVX2__) || defined(__AVX__) - const double avx_true = -std::numeric_limits::quiet_NaN(); - const double avx_false = 0.0; - switch(idx) { - case 0: return SimdVec(avx_true, avx_true, avx_true, avx_true); - case 1: return SimdVec(avx_false, avx_true, avx_true, avx_true); - case 2: return SimdVec(avx_false, avx_false, avx_true, avx_true); - case 3: return SimdVec(avx_false, avx_false, avx_false, avx_true); - default: return SimdVec(avx_false, avx_false, avx_false, avx_false); - } -#else - return (idx>0) ? SimdVec(false) : SimdVec(true); -#endif - } - - /******************************************* - * Debug functions - *******************************************/ - - /// Prints the vector (inefficient, use for debug only) - void print() { - for(ipc_ i=0; i -#include -#include - -#include "ssids_routines.h" -#include "galahad_precision.h" -#include "ssids_contrib.h" -#include "ssids_cpu_NumericNode.hxx" -#include "ssids_cpu_SymbolicNode.hxx" -#include "ssids_cpu_Workspace.hxx" - -namespace galahad { namespace ssids { namespace cpu { - -/** Assemble a column. - * - * Performs the operation dest( idx(:) ) += src(:) - */ -template -inline -void asm_col(ipc_ n, ipc_ const* idx, T const* src, T* dest) { - ipc_ const nunroll = 4; - ipc_ n2 = nunroll*(n/nunroll); - for(ipc_ j=0; j -void add_a_block(ipc_ from, ipc_ to, NumericNode& node, T const* aval, - T const* scaling) { - SymbolicNode const& snode = node.symb; - size_t ldl = node.get_ldl(); - if(scaling) { - /* Scaling to apply */ - for(ipc_ i=from; i= snode.ncol) k += node.ndelay_in; - T rscale = scaling[ snode.rlist[r]-1 ]; - T cscale = scaling[ snode.rlist[c]-1 ]; - node.lcol[k] = rscale * aval[src] * cscale; - } - } else { - /* No scaling to apply */ - for(ipc_ i=from; i= snode.ncol) k += node.ndelay_in; - node.lcol[k] = aval[src]; - } - } -} - -/** - * \brief Assemble expected entries (i.e. not delays) into block column of - * the factors \f$L\f$ - * \param from First column of block column. - * \param to Last column of block column. - * \param node Node to assemble into. - * \param cnode Node to assemble from. - * \param map Map of node's entries. - * \param cache Length cm lookup vector. - */ -template -void assemble_expected(ipc_ from, ipc_ to, NumericNode& node, NumericNode const& cnode, MapVector const& map, ipc_* cache) { - SymbolicNode const& csnode = cnode.symb; - ipc_ cm = csnode.nrow - csnode.ncol; - for(ipc_ j=from; j -void assemble_expected_contrib(ipc_ from, ipc_ to, NumericNode& node, NumericNode const& cnode, MapVector const& map, ipc_* cache) { - SymbolicNode const& csnode = cnode.symb; - ipc_ cm = csnode.nrow - csnode.ncol; - ipc_ ncol = node.symb.ncol + node.ndelay_in; - for(ipc_ j=from; j= node.symb.ncol) { - // Contribution added to contrib - ipc_ ldd = node.symb.nrow - node.symb.ncol; - T *dest = &node.contrib[(c-ncol)*ldd]; - asm_col(cm-i, &cache[i], &src[i], dest); - } - } -} - -template -void assemble_pre( - bool posdef, - ipc_ n, - SymbolicNode const& snode, - void** child_contrib, - NumericNode& node, - FactorAlloc& factor_alloc, - PoolAlloc& pool_alloc, - std::vector& work, - T const* aval, - T const* scaling - ) { - /* Rebind allocators */ - typedef typename std::allocator_traits::template rebind_traits FAPrecisionTraits; - typename FAPrecisionTraits::allocator_type factor_alloc_precision(factor_alloc); - typedef typename std::allocator_traits::template rebind_traits FAIntTraits; - typename FAIntTraits::allocator_type factor_alloc_int(factor_alloc); - typedef typename std::allocator_traits::template rebind_traits PAIntTraits; - typename PAIntTraits::allocator_type pool_alloc_int(pool_alloc); - - /* Count incoming delays and determine size of node */ - node.ndelay_in = 0; - for(auto* child=node.first_child; child!=NULL; child=child->next_child) { - node.ndelay_in += child->ndelay_out; - } - for(int contrib_idx : snode.contrib) { - ipc_ cn, ldcontrib, ndelay, lddelay; - rpc_ const *cval, *delay_val; - ipc_ const *crlist, *delay_perm; - galahad_ssids_contrib_get_data( - child_contrib[contrib_idx], &cn, &cval, &ldcontrib, &crlist, - &ndelay, &delay_perm, &delay_val, &lddelay - ); - node.ndelay_in += ndelay; - } - ipc_ nrow = snode.nrow + node.ndelay_in; - ipc_ ncol = snode.ncol + node.ndelay_in; - - /* Get space for node now we know it size using Fortran allocator + zero it*/ - // NB L is nrow x ncol and D is 2 x ncol (but no D if posdef) - size_t ldl = align_lda(nrow); - size_t len = posdef ? ldl * ncol // posdef - : (ldl+2) * ncol; // indef (includes D) - node.lcol = FAPrecisionTraits::allocate(factor_alloc_precision, len); - //memset(node.lcol, 0, len*sizeof(T)); NOT REQUIRED as PoolAlloc is - // required to ensure it is zero for us (i.e. uses calloc) - - /* Get space for contribution block + (explicitly do not zero it!) */ - node.alloc_contrib(); - - /* Alloc + set perm for expected eliminations at this node (delays are set - * when they are imported from children) */ - node.perm = FAIntTraits::allocate(factor_alloc_int, ncol); // ncol fully summed variables - for(ipc_ i=0; i( - PAIntTraits::allocate(pool_alloc_int, n+1), map_deleter); - for(ipc_ i=0; inext_child) { - SymbolicNode const& csnode = child->symb; - /* Handle delays - go to back of node - * (i.e. become the last rows as in lower triangular format) */ - for(ipc_ i=0; indelay_out; i++) { - // Add delayed rows (from delayed cols) - T *dest = &node.lcol[delay_col*(ldl+1)]; - ipc_ lds = align_lda(csnode.nrow + child->ndelay_in); - T *src = &child->lcol[(child->nelim+i)*(lds+1)]; - node.perm[delay_col] = child->perm[child->nelim+i]; - for(ipc_ j=0; jndelay_out-i; j++) { - dest[j] = src[j]; - } - // Add child's non-fully summed rows (from delayed cols) - dest = node.lcol; - src = &child->lcol[child->nelim*lds + child->ndelay_in +i*lds]; - for(ipc_ j=csnode.ncol; jcontrib) { - ipc_ cm = csnode.nrow - csnode.ncol; - ipc_ const block_size = 256; // FIXME: make configurable? - if(cm < block_size) { - // Single block - ipc_* cache = work[omp_get_thread_num()].get_ptr(cm); - assemble_expected(0, cm, node, *child, map, cache); - } else { - // Multiple blocks - #pragma omp taskgroup - for(ipc_ iblk=0; iblk(cm); - assemble_expected(iblk, std::min(iblk+block_size,cm), node, - *child, map, cache); - } /* task */ - } - } - } - } - /* Add any contribution block from other subtrees */ - for(ipc_ contrib_idx : snode.contrib) { - ipc_ cn, ldcontrib, ndelay, lddelay; - rpc_ const *cval, *delay_val; - ipc_ const *crlist, *delay_perm; - galahad_ssids_contrib_get_data( - child_contrib[contrib_idx], &cn, &cval, &ldcontrib, &crlist, - &ndelay, &delay_perm, &delay_val, &lddelay - ); - ipc_* cache = work[omp_get_thread_num()].get_ptr(cn); - for(ipc_ j=0; j(nrow); - T *dest = &node.lcol[c*ldd]; - asm_col(cn-i, &cache[i], &src[i], dest); - } - } - } -} - -template -void assemble_post( - ipc_ n, - SymbolicNode const& snode, - void** child_contrib, - NumericNode& node, - PoolAlloc& pool_alloc, - std::vector& work - ) { - /* Rebind allocators */ - typedef typename std::allocator_traits::template rebind_traits PAIntTraits; - typename PAIntTraits::allocator_type pool_alloc_int(pool_alloc); - - /* Initialise variables */ - ipc_ ncol = snode.ncol + node.ndelay_in; - - /* Add children */ - ipc_* map = nullptr; - if(node.first_child != NULL || snode.contrib.size() > 0) { - /* Build lookup vector, allowing for insertion of delayed vars */ - /* Note that while rlist[] is 1-indexed this is fine so long as lookup - * is also 1-indexed (which it is as it is another node's rlist[] */ - if(!map) map = PAIntTraits::allocate(pool_alloc_int, n+1); - // FIXME: probably don't need to worry about first ncol? - for(ipc_ i=0; inext_child) { - SymbolicNode const& csnode = child->symb; - if(!child->contrib) continue; - ipc_ cm = csnode.nrow - csnode.ncol; - ipc_ const block_size = 256; - if(cm < block_size) { - ipc_* cache = work[omp_get_thread_num()].get_ptr(cm); - assemble_expected_contrib(0, cm, node, *child, map, cache); - } else { - #pragma omp taskgroup - for(ipc_ iblk=0; iblk(cm); - assemble_expected_contrib(iblk, std::min(iblk+block_size,cm), - node, *child, map, cache); - } /* task */ - } - } - /* Free memory from child contribution block */ - child->free_contrib(); - } - } - /* Add any contribution block from other subtrees */ - for(ipc_ contrib_idx : snode.contrib) { - ipc_ cn, ldcontrib, ndelay, lddelay; - rpc_ const *cval, *delay_val; - ipc_ const *crlist, *delay_perm; - galahad_ssids_contrib_get_data( - child_contrib[contrib_idx], &cn, &cval, &ldcontrib, &crlist, - &ndelay, &delay_perm, &delay_val, &lddelay - ); - if(!cval) continue; // child was all delays, nothing to do - ipc_* cache = work[omp_get_thread_num()].get_ptr(cn); - for(ipc_ j=0; j= snode.ncol) { - // Contribution added to contrib - ipc_ ldd = snode.nrow - snode.ncol; - T *dest = &node.contrib[(c-ncol)*ldd]; - asm_col(cn-i, &cache[i], &src[i], dest); - } - } - /* Free memory from child contribution block */ - galahad_ssids_contrib_free(child_contrib[contrib_idx]); - } - if(map) PAIntTraits::deallocate(pool_alloc_int, map, n+1); -} - -}}} /* namespaces galahad::ssids::cpu */ diff --git a/include/ssids_cpu_kernels_block_ldlt.hxx b/include/ssids_cpu_kernels_block_ldlt.hxx deleted file mode 100644 index 28195082e8..0000000000 --- a/include/ssids_cpu_kernels_block_ldlt.hxx +++ /dev/null @@ -1,455 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 09:00 GMT - */ -#pragma once - -#include // FIXME: remove debug? -#include -#include -#include - -#include "ssids_routines.h" -#include "galahad_precision.h" -#include "ssids_cpu_ThreadStats.hxx" -#include "ssids_cpu_kernels_SimdVec.hxx" - -namespace galahad { namespace ssids { namespace cpu { -namespace block_ldlt_internal { - -/** Swaps two columns of A */ -/* NB: ldwork only well defined for c -void swap_cols(ipc_ idx1, ipc_ idx2, ipc_ n, T *a, ipc_ lda, T *ldwork, ipc_ *perm) { - if(idx1==idx2) return; // noop - - /* Ensure wlog idx1 < idx2 */ - if(idx1 > idx2) { - ipc_ temp = idx1; - idx1 = idx2; - idx2 = temp; - } - - /* Swap perm */ - if(perm) { - ipc_ temp = perm[idx1]; - perm[idx1] = perm[idx2]; - perm[idx2] = temp; - } - - /* Swap ldwork */ - if(ldwork) { - for(ipc_ c=0; c -void find_maxloc(const ipc_ from, const T *a, ipc_ lda, T &bestv_out, ipc_ &rloc, ipc_ &cloc) { - typedef SimdVec SimdVecT; - - /* Handle special cases: - * 1) block size less than vector length - * 2) block size not multiple of twice vector length - */ - if( BLOCK_SIZE < SimdVecT::vector_length || - BLOCK_SIZE % (2*SimdVecT::vector_length) != 0) { - T bestv = -1.0; - rloc = BLOCK_SIZE; cloc = BLOCK_SIZE; - for(ipc_ c=from; c bestv) { - bestv = fabs(v); - rloc = r; - cloc = c; - } - } - } - bestv_out = - (cloc < BLOCK_SIZE && rloc < BLOCK_SIZE) ? a[cloc*lda+rloc] - : 0.0; - return; - } - - // Define a union that lets us abuse T to store ints and still use avx - // blend. The integer field must be no wider than T: the index is - // round-tripped through a T-sized SIMD lane below, so a wider field - // (e.g. 64-bit int with 32-bit float) would leave the high bytes - // uninitialised on readback, giving garbage rloc/cloc and an - // out-of-range access. Block-local indices are < BLOCK_SIZE, so a 32-bit - // field always suffices when ipc_ is too wide for T. - typedef typename std::conditional< - ( sizeof( ipc_ ) <= sizeof( T ) ), ipc_, std::int32_t >::type idxint; - union intT { - idxint i; - T d; - }; - - // Initialize best in lane vars to value 0.0 and position INT_MAX,INT_MAX - SimdVecT bestv(-1.0); - SimdVecT bestv2(-1.0); - intT imax; - imax.i = std::numeric_limits::max(); - SimdVecT bestr(imax.d); - SimdVecT bestr2(imax.d); - SimdVecT bestc(imax.d); - SimdVecT bestc2(imax.d); - // Loop over array at stride equal to vector length - for(ipc_ c=from; c bestv); - v_gt_bestv = v_gt_bestv & SimdVecT::gt_mask(c%vlen); - // If better, update best in lane - bestv = blend(bestv, v, v_gt_bestv); - bestr = blend(bestr, r_vec, v_gt_bestv); - bestc = blend(bestc, c_vec, v_gt_bestv); - } - // Handle any second part of the first 2*vlen chunk - if(vlen*(c/vlen + 1) < 2*vlen*(c/(2*vlen) + 1)) { - intT r_d; - r_d.i = vlen *(c/vlen + 1); - SimdVecT r_vec(r_d.d); - // Load vector of values, taking absolute value - SimdVecT v = fabs(SimdVecT::load_aligned(&a[c*lda+r_d.i])); - // If better, update best in lane - SimdVecT v_gt_bestv = (v > bestv); - bestv = blend(bestv, v, v_gt_bestv); - bestr = blend(bestr, r_vec, v_gt_bestv); - bestc = blend(bestc, c_vec, v_gt_bestv); - } - // Remaining iterations can use full vector with unroll of 2 - intT r_d, r_d2; - for(r_d.i=2*vlen*(c/(2*vlen) + 1); r_d.i bestv); - bestv = blend(bestv, v, v_gt_bestv); - bestr = blend(bestr, r_vec, v_gt_bestv); - bestc = blend(bestc, c_vec, v_gt_bestv); - SimdVecT v_gt_bestv2 = (v2 > bestv2); - bestv2 = blend(bestv2, v2, v_gt_bestv2); - bestr2 = blend(bestr2, r_vec2, v_gt_bestv2); - bestc2 = blend(bestc2, c_vec, v_gt_bestv2); - } - } - // Merge bestv and bestv2 - SimdVecT v_gt_bestv = (bestv2 > bestv); - bestv = blend(bestv, bestv2, v_gt_bestv); - bestr = blend(bestr, bestr2, v_gt_bestv); - bestc = blend(bestc, bestc2, v_gt_bestv); - // Extract results -#if defined(__AVX512F__) - T __attribute__((aligned(64))) bv2[SimdVecT::vector_length]; - intT __attribute__((aligned(64))) br2[SimdVecT::vector_length], bc2[SimdVecT::vector_length]; -#elif defined(__AVX__) - T __attribute__((aligned(32))) bv2[SimdVecT::vector_length]; - intT __attribute__((aligned(32))) br2[SimdVecT::vector_length], bc2[SimdVecT::vector_length]; -#else - T __attribute__((aligned(16))) bv2[SimdVecT::vector_length]; - intT __attribute__((aligned(16))) br2[SimdVecT::vector_length], bc2[SimdVecT::vector_length]; -#endif - bestv.store_aligned(bv2); - bestr.store_aligned(&br2[0].d); - bestc.store_aligned(&bc2[0].d); - bestv_out = bv2[0]; - rloc = br2[0].i; - cloc = bc2[0].i; - for(ipc_ i=1; i bestv_out) { - bestv_out = bv2[i]; - rloc = br2[i].i + i; // NB rloc only stores base of vector, so need +i - cloc = bc2[i].i; - } - } - bestv_out = a[cloc*lda+rloc]; -} - -/** Returns true if a 2x2 pivot can be stably inverted. - * - * We assume that a21 is the maximum entry in the matrix, at which stage - * the proofs in doc/LDLT.tex apply. - */ -template -bool test_2x2(T a11, T a21, T a22, T &detpiv, T &detscale) { - detscale = 1.0/fabs(a21); // |a21|=max(|a11|, |a21|, |a22|) by construction - detpiv = (a11*detscale) * a22 - fabs(a21); - return (fabs(detpiv) >= fabs(a21)/2); -} - -/** Updates the trailing submatrix (2x2 case) */ -template -void update_2x2(ipc_ p, T *a, ipc_ lda, const T *ld) { - for(ipc_ c=p+2; c -void update_1x1(ipc_ p, T *a, ipc_ lda, const T *ld) { -#if 0 - for(ipc_ c=p+1; c::vector_length; - const ipc_ unroll=4; // How many iteration of loop we're doing - - // Handle case of small BLOCK_SIZE safely - if(BLOCK_SIZE < vlen || BLOCK_SIZE%vlen != 0 || BLOCK_SIZE < unroll) { - for(ipc_ c=p+1; c ldvec( -ld[c] ); // NB minus so we can use fma below - for(ipc_ r=vlen*(c/vlen); r lvec = SimdVec::load_aligned(&a[p*lda+r]); - SimdVec avec = SimdVec::load_aligned(&a[c*lda+r]); - avec = fmadd(avec, lvec, ldvec); - avec.store_aligned(&a[c*lda+r]); - } - } - for(ipc_ c=unroll*((p+1-1)/unroll+1); c ldvec0( -ld[c] ); // NB minus so we can use fma below - SimdVec ldvec1( -ld[c+1] ); // NB minus so we can use fma below - SimdVec ldvec2( -ld[c+2] ); // NB minus so we can use fma below - SimdVec ldvec3( -ld[c+3] ); // NB minus so we can use fma below - for(ipc_ r=vlen*(c/vlen); r lvec = SimdVec::load_aligned(&a[p*lda+r]); - SimdVec avec0 = SimdVec::load_aligned(&a[(c+0)*lda+r]); - SimdVec avec1 = SimdVec::load_aligned(&a[(c+1)*lda+r]); - SimdVec avec2 = SimdVec::load_aligned(&a[(c+2)*lda+r]); - SimdVec avec3 = SimdVec::load_aligned(&a[(c+3)*lda+r]); - avec0 = fmadd(avec0, lvec, ldvec0); - avec1 = fmadd(avec1, lvec, ldvec1); - avec2 = fmadd(avec2, lvec, ldvec2); - avec3 = fmadd(avec3, lvec, ldvec3); - avec0.store_aligned(&a[(c+0)*lda+r]); - avec1.store_aligned(&a[(c+1)*lda+r]); - avec2.store_aligned(&a[(c+2)*lda+r]); - avec3.store_aligned(&a[(c+3)*lda+r]); - } - } -#endif -} - -} // namespace block_ldlt_internal - -/** Factorize a square block without restricting pivots - * Expects to be given a square block of size BLOCK_SIZE with numbers of - * interest in bottom right part. */ -template -void block_ldlt(ipc_ from, ipc_ *perm, T *a, ipc_ lda, T *d, T *ldwork, - bool action, const T u, const T small, ipc_ *lperm=nullptr) { - using namespace block_ldlt_internal; - - /* Main loop */ - for(ipc_ p=from; p(p, a, lda, bestv, t, m); - - // Handle case where everything remaining is small - // NB: There might be delayed columns! - if(fabs(bestv) < small) { - if(!action) throw SingularError(p); - // Loop over remaining columns - for(; p fabs(a22)) { - // Go for a11 as 1x1 pivot - pivsiz = 1; - t = m; - if(fabs(a11 / a21) < u) pivsiz = 0; // Fail pivot - } else { - // Go for a22 as 1x1 pivot - pivsiz = 1; - a11 = a22; - m = t; - if(fabs(a22 / a21) < u) pivsiz = 0; // Fail pivot - } - } - } - - // Apply pivot, swapping columns as required - if(pivsiz == 0) { - // FIXME: debug remove - printf("broken!\n"); - printf("t = %" d_ipc_ " m = %" d_ipc_ "\n", t2, m2); - a11 = a[m2*lda+m2]; -#ifdef REAL_128 - char buf1[128]; - int n1 = quadmath_snprintf(buf1, sizeof buf1, - "%+-#*.20Qe", a[m2*lda+m2]); - if ((size_t) n1 < sizeof buf1) - printf("[%" d_ipc_ "] = %s\n", m2*BLOCK_SIZE+m2, buf1); -// printf("[%" d_ipc_ "] = %q\n", m2*BLOCK_SIZE+m2, a[m2*lda+m2]); -#else - printf("[%" d_ipc_ "] = %e\n", m2*BLOCK_SIZE+m2, a[m2*lda+m2]); -#endif - a22 = a[t2*lda+t2]; - a21 = a[m2*lda+t2]; -#ifdef REAL_128 - char buf11[128], buf21[128], buf22[128]; - int n11 = quadmath_snprintf(buf11, sizeof buf11, - "%+-#*.20Qe", a11); - int n21 = quadmath_snprintf(buf21, sizeof buf21, - "%+-#*.20Qe", a21); - int n22 = quadmath_snprintf(buf22, sizeof buf22, - "%+-#*.20Qe", a22); - if ((size_t) n11 < sizeof buf11 && - (size_t) n21 < sizeof buf21 && - (size_t) n22 < sizeof buf22) - printf("a11 = %s a21 = %s a22 = %s\n", buf11, buf21, buf22); -// printf("a11 = %Qe a21 = %Qe a22 = %Qe\n", a11, a21, a22); -#else - printf("a11 = %e a21 = %e a22 = %e\n", a11, a21, a22); -#endif - exit(1); - } - if(pivsiz == 1) { - /* 1x1 pivot */ - T d11 = 1.0/a11; - swap_cols - (p, t, BLOCK_SIZE, a, lda, ldwork, perm); - if(lperm) { ipc_ temp=lperm[p]; lperm[p]=lperm[t]; lperm[t]=temp; } - /* Divide through, preserving a copy */ - T *work = &ldwork[p*BLOCK_SIZE]; - for(ipc_ r=p+1; r(p, a, lda, work); - /* Store d */ - d[2*p] = d11; - d[2*p+1] = 0.0; - /* Set diagonal to I */ - a[p*lda+p] = 1.0; - } else { - /* 2x2 pivot */ - /* NB t > m by construction. Hence m>=p, t>=p+1 and swaps are safe */ - swap_cols - (p, m, BLOCK_SIZE, a, lda, ldwork, perm); - if(lperm) { ipc_ temp=lperm[p]; lperm[p]=lperm[m]; lperm[m]=temp; } - swap_cols - (p+1, t, BLOCK_SIZE, a, lda, ldwork, perm); - if(lperm) { ipc_ temp=lperm[p+1]; lperm[p+1]=lperm[t]; lperm[t]=temp; } - /* Calculate 2x2 inverse */ - T d11 = (a22*detscale)/detpiv; - T d22 = (a11*detscale)/detpiv; - T d21 = (-a21*detscale)/detpiv; - /* Divide through, preserving a copy */ - T *work = &ldwork[p*BLOCK_SIZE]; - for(ipc_ r=p+2; r(p, a, lda, work); - /* Store d */ - d[2*p ] = d11; - d[2*p+1] = d21; -#ifdef REAL_128 - d[2*p+2] = 1.0/0.0; -#else - d[2*p+2] = std::numeric_limits::infinity(); -#endif - d[2*p+3] = d22; - /* Set diagonal to I */ - a[p*(lda+1)] = 1.0; - a[p*(lda+1)+1] = 0.0; - a[(p+1)*(lda+1)] = 1.0; - } - p += pivsiz; - } -} -}}} /* namespaces galahad::ssids::cpu */ diff --git a/include/ssids_cpu_kernels_calc_ld.hxx b/include/ssids_cpu_kernels_calc_ld.hxx deleted file mode 100644 index a59f553482..0000000000 --- a/include/ssids_cpu_kernels_calc_ld.hxx +++ /dev/null @@ -1,134 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 09:00 GMT - */ - -#pragma once - -#include -#include - -#include "ssids_routines.h" -#include "galahad_precision.h" -#include "ssids_cpu_kernels_common.hxx" -#include "ssids_cpu_kernels_SimdVec.hxx" - -namespace galahad { namespace ssids { namespace cpu { - -/** Return number of elements to skip at beginning to get an aligned element, - * or max int if alignment is not (trivally) possible. - * - * Note this will mostly just fail if sizeof(T) doesn't divide into alignment. - */ -template -ipc_ offset_to_align(T* ptr) { -#if defined(__AVX512F__) - ipc_ const align = 64; -#elif defined(__AVX__) - ipc_ const align = 32; -#else - ipc_ const align = 16; -#endif - uintptr_t offset = align - (reinterpret_cast(ptr) % align); - offset /= sizeof(T); - if((reinterpret_cast(ptr+offset) % align) == 0) return offset; - else return std::numeric_limits::max(); -} - -/** Calculates LD from L and D. - * - * We assume that both l and ld are 32-bytes aligned, and ldl and ldld are - * multiples of 32 bytes, so we can use AVX. - */ -template -void calcLD(ipc_ m, ipc_ n, T const* l, ipc_ ldl, T const* d, T* ld, - ipc_ ldld) { - typedef SimdVec SimdVecT; - - for(ipc_ col=0; col(d[2*col+2]))) { -#else - if(col+1==n || std::isfinite(d[2*col+2])) { -#endif - // 1x1 pivot - T d11 = d[2*col]; - if(d11 != 0.0) d11 = 1/d11; // Zero pivots just cause zeroes - if(op==OP_N) { - ipc_ const vlen = SimdVecT::vector_length; - ipc_ const unroll = 4; - ipc_ offset = offset_to_align(l); - if(offset_to_align(ld) != offset) offset = m; // give up on vectors - ipc_ i0_ = 0; - ipc_ nvec = std::max(i0_, (m-offset) / vlen); - for(ipc_ row=0; row - __device__ - __forceinline__ - T loadVolatile(volatile T &val) { - return val; - } - template - __device__ - __forceinline__ - const T loadVolatile(const volatile T &val) { - return val; - } -#endif -} - -}}} /* namespaces galahad::ssids::cpu */ diff --git a/include/ssids_cpu_kernels_ldlt_app.hxx b/include/ssids_cpu_kernels_ldlt_app.hxx deleted file mode 100644 index f471995f07..0000000000 --- a/include/ssids_cpu_kernels_ldlt_app.hxx +++ /dev/null @@ -1,34 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 08:00 GMT - */ - -#pragma once - -#include - -#include "ssids_routines.h" -#include "galahad_precision.h" -#include "ssids_cpu_Workspace.hxx" - -namespace galahad { namespace ssids { namespace cpu { - -template -ipc_ ldlt_app_factor(ipc_ m, ipc_ n, ipc_ *perm, T *a, ipc_ lda, T *d, T beta, - T* upd, ipc_ ldupd, struct cpu_factor_control const& control, - std::vector& work, Allocator const& alloc); - -template -void ldlt_app_solve_fwd(ipc_ m, ipc_ n, T const* l, ipc_ ldl, ipc_ nrhs, T* x, - ipc_ ldx); - -template -void ldlt_app_solve_diag(ipc_ n, T const* d, ipc_ nrhs, T* x, ipc_ ldx); - -template -void ldlt_app_solve_bwd(ipc_ m, ipc_ n, T const* l, ipc_ ldl, ipc_ nrhs, T* x, - ipc_ ldx); - -}}} /* namespaces galahad::ssids::cpu */ diff --git a/include/ssids_cpu_kernels_ldlt_nopiv.hxx b/include/ssids_cpu_kernels_ldlt_nopiv.hxx deleted file mode 100644 index b629eb961d..0000000000 --- a/include/ssids_cpu_kernels_ldlt_nopiv.hxx +++ /dev/null @@ -1,23 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 08:00 GMT - */ - -#pragma once - -#include "ssids_routines.h" -#include "galahad_precision.h" - -namespace galahad { namespace ssids { namespace cpu { - -ipc_ ldlt_nopiv_factor(ipc_ m, ipc_ n, rpc_* a, ipc_ lda, rpc_* work); -void ldlt_nopiv_solve_fwd(ipc_ m, ipc_ n, rpc_ const* a, ipc_ lda, - rpc_ *x); -void ldlt_nopiv_solve_diag(ipc_ m, ipc_ n, rpc_ const* a, ipc_ lda, - rpc_ *x); -void ldlt_nopiv_solve_bwd(ipc_ m, ipc_ n, rpc_ const* a, ipc_ lda, - rpc_ *x); - -}}} /* namespaces galahad::ssids::cpu */ diff --git a/include/ssids_cpu_kernels_ldlt_tpp.hxx b/include/ssids_cpu_kernels_ldlt_tpp.hxx deleted file mode 100644 index 1dfeadbe58..0000000000 --- a/include/ssids_cpu_kernels_ldlt_tpp.hxx +++ /dev/null @@ -1,24 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 08:00 GMT - */ - -#pragma once - -#include "ssids_routines.h" -#include "galahad_precision.h" - -namespace galahad { namespace ssids { namespace cpu { - -ipc_ ldlt_tpp_factor(ipc_ m, ipc_ n, ipc_* perm, rpc_* a, ipc_ lda, rpc_* d, - rpc_* ld, ipc_ ldld, bool action, rpc_ u, rpc_ small, - ipc_ nleft=0, rpc_ *aleft=nullptr, ipc_ ldleft=0); -void ldlt_tpp_solve_fwd(ipc_ m, ipc_ n, rpc_ const* l, ipc_ ldl, ipc_ nrhs, - rpc_* x, ipc_ ldx); -void ldlt_tpp_solve_diag(ipc_ n, rpc_ const* d, rpc_* x); -void ldlt_tpp_solve_bwd(ipc_ m, ipc_ n, rpc_ const* l, ipc_ ldl, ipc_ nrhs, - rpc_* x, ipc_ ldx); - -}}} /* end of namespace galahad::ssids::cpu */ diff --git a/include/ssids_cpu_kernels_verify.hxx b/include/ssids_cpu_kernels_verify.hxx deleted file mode 100644 index 3aed4e3e6f..0000000000 --- a/include/ssids_cpu_kernels_verify.hxx +++ /dev/null @@ -1,187 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 08:00 GMT - */ - -#pragma once - -#include - -#include "ssids_routines.h" -#include "galahad_precision.h" -#include "ssids_cpu_kernels_wrappers.hxx" - -namespace galahad { namespace ssids { namespace cpu { - -namespace verify_internal { - -template -void calcLD(ipc_ m, ipc_ n, T const* lcol, ipc_ ldl, T const* d, T* ld) { - for(ipc_ j=0; j -class Verify { -public: - Verify(ipc_ m, ipc_ n, ipc_ const* perm, T const* a, ipc_ lda) - : m_(m), n_(n), lda_(m), a_(m*n), perm_(n) - { - // Take a copy - for(ipc_ j=0; j= c) { - if(std::abs(a_[c*lda_+r] - ldlt[j*nelim+i]) > 1e-10) { - printf("Mismatch1 [%d,%d]=%e != [%d,%d]=%e diff %e\n", r, c, - a_[c*lda_+r], i, j, ldlt[j*nelim+i], - std::abs(a_[c*lda_+r] - ldlt[j*nelim+i])); - exit(1); - } - } else { - if(std::abs(a_[r*lda_+c] - ldlt[j*nelim+i]) > 1e-12) { - printf("Mismatch1 [%d,%d]=%e != [%d,%d]=%e diff %e\n", c, r, - a_[r*lda_+c], i, j, ldlt[j*nelim+i], - std::abs(a_[r*lda_+c] - ldlt[j*nelim+i])); - exit(1); - } - } - } - } - delete[] ldlt; - - // Apply pivots to block below - if(m_ > nelim) { - T *below = new T[(m_-nelim)*nelim]; - host_gemm( - OP_N, OP_T, m_-nelim, nelim, nelim, 1.0, &lcopy[nelim], m_, - ld, nelim, 0.0, below, m_-nelim - ); - // rows nelim:n may be permuted - for(ipc_ j=0; j= c) { - if(std::abs(a_[c*lda_+r] - below[j*(m_-nelim)+i-nelim]) > 1e-10) { - printf("Mismatch2 [%d,%d]=%e != [%d,%d]=%e diff %e\n", r, c, - a_[c*lda_+r], i, j, below[j*(m_-nelim)+i-nelim], - std::abs(a_[c*lda_+r] - below[j*(m_-nelim)+i-nelim])); - exit(1); - } - } else { - if(std::abs(a_[r*lda_+c] - below[j*(m_-nelim)+i-nelim]) > 1e-12) { - printf("Mismatch2 [%d,%d]=%e != [%d,%d]=%e diff %e\n", c, r, - a_[r*lda_+c], i, j, below[j*(m_-nelim)+i-nelim], - std::abs(a_[r*lda_+c] - below[j*(m_-nelim)+i-nelim])); - exit(1); - } - } - } - } - // rows nelim:n are only column permuted - for(ipc_ j=0; j 1e-10) { - printf("Mismatch3 [%d,%d]=%e != [%d,%d]=%e diff %e\n", r, c, - a_[c*lda_+r], i, j, below[j*(m_-nelim)+i-nelim], - std::abs(a_[c*lda_+r] - below[j*(m_-nelim)+i-nelim])); - exit(1); - } - } - } - delete[] below; - } - - // release memory - delete[] ld; - delete[] lperm; - delete[] lcopy; - } - -private: - ipc_ m_; - ipc_ n_; - ipc_ lda_; - std::vector a_; - std::vector perm_; -}; - - -}}} /* end of namespace galahad::ssids::cpu */ diff --git a/include/ssids_cpu_kernels_wrappers.hxx b/include/ssids_cpu_kernels_wrappers.hxx deleted file mode 100644 index 1b2623047c..0000000000 --- a/include/ssids_cpu_kernels_wrappers.hxx +++ /dev/null @@ -1,115 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 08:00 GMT - */ - -#pragma once - -#include - -#include "ssids_routines.h" -#include "galahad_precision.h" -#include "ssids_cpu_kernels_common.hxx" - -namespace galahad { namespace ssids { namespace cpu { - -/* _GEMM */ -template -void host_gemm(enum galahad::ssids::cpu::operation transa, - enum galahad::ssids::cpu::operation transb, - int m, int n, int k, T alpha, const T* a, - int lda, const T* b, int ldb, T beta, - T* c, int ldc); - -/* _GEMV */ -template -void gemv(enum galahad::ssids::cpu::operation trans, - int m, int n, T alpha, const T* a, int lda, - const T* x, int incx, T beta, T* y, int incy); - -/* _POTRF */ -template -int lapack_potrf(enum galahad::ssids::cpu::fillmode uplo, int n, - T* a, int lda); - -/* _SYTRF - Bunch-Kaufman factorization */ -template -int lapack_sytrf(enum galahad::ssids::cpu::fillmode uplo, - int n, T* a, int lda, int* ipiv, - T* work, int lwork); - -/* _SYRK */ -template -void host_syrk(enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation trans, - int n, int k, T alpha, const T* a, int lda, - T beta, T* c, int ldc); - -/* _TRSV */ -template -void host_trsv(enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation trans, - enum galahad::ssids::cpu::diagonal diag, - int n, const T* a, int lda, T* x, int incx); - -/* _TRSM */ -template -void host_trsm(enum galahad::ssids::cpu::side side, - enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation transa, - enum galahad::ssids::cpu::diagonal diag, - int m, int n, T alpha, const T* a, int lda, - T* b, int ldb); - -/* _GEMM_64 */ -template -void host_gemm_64(enum galahad::ssids::cpu::operation transa, - enum galahad::ssids::cpu::operation transb, - longc_ m, longc_ n, longc_ k, T alpha, const T* a, - longc_ lda, const T* b, longc_ ldb, T beta, - T* c, longc_ ldc); - -/* _GEMV_64 */ -template -void gemv_64(enum galahad::ssids::cpu::operation trans, - longc_ m, longc_ n, T alpha, const T* a, longc_ lda, - const T* x, longc_ incx, T beta, T* y, longc_ incy); - -/* _POTRF_64 */ -template -longc_ lapack_potrf_64(enum galahad::ssids::cpu::fillmode uplo, longc_ n, - T* a, longc_ lda); - -/* _SYTRF_64 - Bunch-Kaufman factorization */ -template -longc_ lapack_sytrf_64(enum galahad::ssids::cpu::fillmode uplo, - longc_ n, T* a, longc_ lda, longc_* ipiv, - T* work, longc_ lwork); - -/* _SYRK_64 */ -template -void host_syrk_64(enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation trans, - longc_ n, longc_ k, T alpha, const T* a, longc_ lda, - T beta, T* c, longc_ ldc); - -/* _TRSV_64 */ -template -void host_trsv_64(enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation trans, - enum galahad::ssids::cpu::diagonal diag, - longc_ n, const T* a, longc_ lda, T* x, longc_ incx); - -/* _TRSM_64 */ -template -void host_trsm_64(enum galahad::ssids::cpu::side side, - enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation transa, - enum galahad::ssids::cpu::diagonal diag, - longc_ m, longc_ n, T alpha, const T* a, longc_ lda, - T* b, longc_ ldb); - -}}} /* namespaces galahad::ssids::cpu */ - diff --git a/include/ssids_omp.hxx b/include/ssids_omp.hxx deleted file mode 100644 index 5d3a545ac8..0000000000 --- a/include/ssids_omp.hxx +++ /dev/null @@ -1,99 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 09:00 GMT - * - * \brief - * Additional support functions and wrappers for OpenMP. - */ -#pragma once - -#ifdef INTEGER_64 -#define AcquiredLock AcquiredLock_64 -#define Lock Lock_64 -#define unset unset_64 -#define set set_64 -#define get_global_thread_num get_global_thread_num_64 -#endif - -#ifdef _OPENMP -#include -#endif /* _OPENMP */ - -/* This file wraps the C interface for OpenMP in C++ for style/safety */ -namespace galahad { namespace omp { - -/** - * \brief Safe wrapper around omp_lock_t ensuring init/cleanup. - * See AcquiredLock for locking functionality. - * - * This acts as an underlying resource that may be aquired by instantiating - * an AcquiredLock with this as an argument. - * - * \sa AcquiredLock - */ -class Lock { -public: - Lock(Lock const&) =delete; - Lock& operator=(Lock const&) =delete; - Lock() { -#ifdef _OPENMP - omp_init_lock(&lock_); -#endif /* _OPENMP */ - } - ~Lock() { -#ifdef _OPENMP - omp_destroy_lock(&lock_); -#endif /* _OPENMP */ - } -private: - inline - void set() { -#ifdef _OPENMP - omp_set_lock(&lock_); -#endif /* _OPENMP */ - } - inline - void unset() { -#ifdef _OPENMP - omp_unset_lock(&lock_); -#endif /* _OPENMP */ - } - inline - bool test() { -#ifdef _OPENMP - return omp_test_lock(&lock_); -#else - return true; -#endif /* _OPENMP */ - } - -#ifdef _OPENMP - omp_lock_t lock_; -#endif /* _OPENMP */ - - friend class AcquiredLock; -}; - -/** - * \brief RAII lock. Acquires lock on construction, releases on destruction. - */ -class AcquiredLock { -public: - AcquiredLock(Lock& lock) - : lock_(lock) - { - lock_.set(); - } - ~AcquiredLock() { - lock_.unset(); - } -private: - Lock& lock_; ///< Underlying lock. -}; - -/// Return global thread number (=thread number if not nested) -int get_global_thread_num(); - -}} /* end of namespace galahad::omp */ diff --git a/include/ssids_routines.h b/include/ssids_routines.h deleted file mode 100644 index e8029764f2..0000000000 --- a/include/ssids_routines.h +++ /dev/null @@ -1,244 +0,0 @@ -#ifdef INTEGER_64 -#ifdef REAL_32 -#define ldlt_app_factor ldlt_app_factor_sgl_64 -#define ldlt_app_solve_fwd ldlt_app_solve_fwd_sgl_64 -#define ldlt_app_solve_diag ldlt_app_solve_diag_sgl_64 -#define ldlt_app_solve_bwd ldlt_app_solve_bwd_sgl_64 -#define ldlt_tpp_factor ldlt_tpp_factor_sgl_64 -#define ldlt_tpp_solve_fwd ldlt_tpp_solve_fwd_sgl_64 -#define ldlt_tpp_solve_diag ldlt_tpp_solve_diag_sgl_64 -#define ldlt_tpp_solve_bwd ldlt_tpp_solve_bwd_sgl_64 -#define ldlt_nopiv_factor ldlt_nopiv_factor_sgl_64 -#define ldlt_nopiv_solve_fwd ldlt_nopiv_solve_fwd_sgl_64 -#define ldlt_nopiv_solve_diag ldlt_nopiv_solve_diag_sgl_64 -#define ldlt_nopiv_solve_bwd ldlt_nopiv_solve_bwd_sgl_64 -#define cholesky_factor cholesky_factor_sgl_64 -#define cholesky_solve_fwd cholesky_solve_fwd_sgl_64 -#define cholesky_solve_bwd cholesky_solve_bwd_sgl_64 -#define galahad_ssids_contrib_get_data galahad_ssids_contrib_get_data_single_64 -#define galahad_ssids_contrib_free galahad_ssids_contrib_free_sgl_64 -#define FAPrecisionTraits FASingleTraits_64 -#define factor_alloc_precision factor_alloc_single_64 -#define galahad_ssids_cpu_create_symbolic_subtree galahad_ssids_cpu_create_symbolic_subtree_sgl_64 -#define galahad_ssids_cpu_destroy_symbolic_subtree galahad_ssids_cpu_destroy_symbolic_subtree_sgl_64 -#define galahad_ssids_cpu_create_num_subtree galahad_ssids_cpu_create_num_subtree_sgl_64 -#define galahad_ssids_cpu_destroy_num_subtree galahad_ssids_cpu_destroy_num_subtree_sgl_64 -#define galahad_ssids_cpu_subtree_solve_fwd galahad_ssids_cpu_subtree_solve_fwd_sgl_64 -#define galahad_ssids_cpu_subtree_solve_diag galahad_ssids_cpu_subtree_solve_diag_sgl_64 -#define galahad_ssids_cpu_subtree_solve_diag_bwd galahad_ssids_cpu_subtree_solve_diag_bwd_sgl_64 -#define galahad_ssids_cpu_subtree_solve_bwd galahad_ssids_cpu_subtree_solve_bwd_sgl_64 -#define galahad_ssids_cpu_subtree_enquire galahad_ssids_cpu_subtree_enquire_sgl_64 -#define galahad_ssids_cpu_subtree_alter galahad_ssids_cpu_subtree_alter_sgl_64 -#define galahad_ssids_cpu_subtree_get_contrib galahad_ssids_cpu_subtree_get_contrib_sgl_64 -#define galahad_ssids_cpu_subtree_free_contrib galahad_ssids_cpu_subtree_free_contrib_sgl_64 -#define ldlt_app_internal ldlt_app_internal_sgl_64 -#define ldlt_app_factor_mem_required ldlt_app_factor_mem_required_sgl_64 -#elif REAL_128 -#define ldlt_app_factor ldlt_app_factor_qul_64 -#define ldlt_app_solve_fwd ldlt_app_solve_fwd_qul_64 -#define ldlt_app_solve_diag ldlt_app_solve_diag_qul_64 -#define ldlt_app_solve_bwd ldlt_app_solve_bwd_qul_64 -#define ldlt_tpp_factor ldlt_tpp_factor_qul_64 -#define ldlt_tpp_solve_fwd ldlt_tpp_solve_fwd_qul_64 -#define ldlt_tpp_solve_diag ldlt_tpp_solve_diag_qul_64 -#define ldlt_tpp_solve_bwd ldlt_tpp_solve_bwd_qul_64 -#define ldlt_nopiv_factor ldlt_nopiv_factor_qul_64 -#define ldlt_nopiv_solve_fwd ldlt_nopiv_solve_fwd_qul_64 -#define ldlt_nopiv_solve_diag ldlt_nopiv_solve_diag_qul_64 -#define ldlt_nopiv_solve_bwd ldlt_nopiv_solve_bwd_qul_64 -#define cholesky_factor cholesky_factor_qul_64 -#define cholesky_solve_fwd cholesky_solve_fwd_qul_64 -#define cholesky_solve_bwd cholesky_solve_bwd_qul_64 -#define galahad_ssids_contrib_get_data galahad_ssids_contrib_get_data_quadruple_64 -#define galahad_ssids_contrib_free galahad_ssids_contrib_free_qul_64 -#define FAPrecisionTraits FAQuadrupleTraits_64 -#define factor_alloc_precision factor_alloc_quadruple_64 -#define galahad_ssids_cpu_create_symbolic_subtree galahad_ssids_cpu_create_symbolic_subtree_qul_64 -#define galahad_ssids_cpu_destroy_symbolic_subtree galahad_ssids_cpu_destroy_symbolic_subtree_qul_64 -#define galahad_ssids_cpu_create_num_subtree galahad_ssids_cpu_create_num_subtree_qul_64 -#define galahad_ssids_cpu_destroy_num_subtree galahad_ssids_cpu_destroy_num_subtree_qul_64 -#define galahad_ssids_cpu_subtree_solve_fwd galahad_ssids_cpu_subtree_solve_fwd_qul_64 -#define galahad_ssids_cpu_subtree_solve_diag galahad_ssids_cpu_subtree_solve_diag_qul_64 -#define galahad_ssids_cpu_subtree_solve_diag_bwd galahad_ssids_cpu_subtree_solve_diag_bwd_qul_64 -#define galahad_ssids_cpu_subtree_solve_bwd galahad_ssids_cpu_subtree_solve_bwd_qul_64 -#define galahad_ssids_cpu_subtree_enquire galahad_ssids_cpu_subtree_enquire_qul_64 -#define galahad_ssids_cpu_subtree_alter galahad_ssids_cpu_subtree_alter_qul_64 -#define galahad_ssids_cpu_subtree_get_contrib galahad_ssids_cpu_subtree_get_contrib_qul_64 -#define galahad_ssids_cpu_subtree_free_contrib galahad_ssids_cpu_subtree_free_contrib_qul_64 -#define ldlt_app_internal ldlt_app_internal_qul_64 -#define ldlt_app_factor_mem_required ldlt_app_factor_mem_required_qul_64 -#else -#define ldlt_app_factor ldlt_app_factor_dbl_64 -#define ldlt_app_solve_fwd ldlt_app_solve_fwd_dbl_64 -#define ldlt_app_solve_diag ldlt_app_solve_diag_dbl_64 -#define ldlt_app_solve_bwd ldlt_app_solve_bwd_dbl_64 -#define ldlt_tpp_factor ldlt_tpp_factor_dbl_64 -#define ldlt_tpp_solve_fwd ldlt_tpp_solve_fwd_dbl_64 -#define ldlt_tpp_solve_diag ldlt_tpp_solve_diag_dbl_64 -#define ldlt_tpp_solve_bwd ldlt_tpp_solve_bwd_dbl_64 -#define ldlt_nopiv_factor ldlt_nopiv_factor_dbl_64 -#define ldlt_nopiv_solve_fwd ldlt_nopiv_solve_fwd_dbl_64 -#define ldlt_nopiv_solve_diag ldlt_nopiv_solve_diag_dbl_64 -#define ldlt_nopiv_solve_bwd ldlt_nopiv_solve_bwd_dbl_64 -#define cholesky_factor cholesky_factor_dbl_64 -#define cholesky_solve_fwd cholesky_solve_fwd_dbl_64 -#define cholesky_solve_bwd cholesky_solve_bwd_dbl_64 -#define galahad_ssids_contrib_get_data galahad_ssids_contrib_get_data_double_64 -#define galahad_ssids_contrib_free galahad_ssids_contrib_free_dbl_64 -#define FAPrecisionTraits FADoubleTraits_64 -#define factor_alloc_precision factor_alloc_double_64 -#define galahad_ssids_cpu_create_symbolic_subtree galahad_ssids_cpu_create_symbolic_subtree_dbl_64 -#define galahad_ssids_cpu_destroy_symbolic_subtree galahad_ssids_cpu_destroy_symbolic_subtree_dbl_64 -#define galahad_ssids_cpu_create_num_subtree galahad_ssids_cpu_create_num_subtree_dbl_64 -#define galahad_ssids_cpu_destroy_num_subtree galahad_ssids_cpu_destroy_num_subtree_dbl_64 -#define galahad_ssids_cpu_subtree_solve_fwd galahad_ssids_cpu_subtree_solve_fwd_dbl_64 -#define galahad_ssids_cpu_subtree_solve_diag galahad_ssids_cpu_subtree_solve_diag_dbl_64 -#define galahad_ssids_cpu_subtree_solve_diag_bwd galahad_ssids_cpu_subtree_solve_diag_bwd_dbl_64 -#define galahad_ssids_cpu_subtree_solve_bwd galahad_ssids_cpu_subtree_solve_bwd_dbl_64 -#define galahad_ssids_cpu_subtree_enquire galahad_ssids_cpu_subtree_enquire_dbl_64 -#define galahad_ssids_cpu_subtree_alter galahad_ssids_cpu_subtree_alter_dbl_64 -#define galahad_ssids_cpu_subtree_get_contrib galahad_ssids_cpu_subtree_get_contrib_dbl_64 -#define galahad_ssids_cpu_subtree_free_contrib galahad_ssids_cpu_subtree_free_contrib_dbl_64 -#define ldlt_app_internal ldlt_app_internal_dbl_64 -#define ldlt_app_factor_mem_required ldlt_app_factor_mem_required_dbl_64 -#endif -#else -#ifdef REAL_32 -#define ldlt_app_factor ldlt_app_factor_sgl -#define ldlt_app_solve_fwd ldlt_app_solve_fwd_sgl -#define ldlt_app_solve_diag ldlt_app_solve_diag_sgl -#define ldlt_app_solve_bwd ldlt_app_solve_bwd_sgl -#define ldlt_tpp_factor ldlt_tpp_factor_sgl -#define ldlt_tpp_solve_fwd ldlt_tpp_solve_fwd_sgl -#define ldlt_tpp_solve_diag ldlt_tpp_solve_diag_sgl -#define ldlt_tpp_solve_bwd ldlt_tpp_solve_bwd_sgl -#define ldlt_nopiv_factor ldlt_nopiv_factor_sgl -#define ldlt_nopiv_solve_fwd ldlt_nopiv_solve_fwd_sgl -#define ldlt_nopiv_solve_diag ldlt_nopiv_solve_diag_sgl -#define ldlt_nopiv_solve_bwd ldlt_nopiv_solve_bwd_sgl -#define cholesky_factor cholesky_factor_sgl -#define cholesky_solve_fwd cholesky_solve_fwd_sgl -#define cholesky_solve_bwd cholesky_solve_bwd_sgl -#define galahad_ssids_contrib_get_data galahad_ssids_contrib_get_data_single -#define galahad_ssids_contrib_free galahad_ssids_contrib_free_sgl -#define FAPrecisionTraits FASingleTraits -#define factor_alloc_precision factor_alloc_single -#define galahad_ssids_cpu_create_symbolic_subtree galahad_ssids_cpu_create_symbolic_subtree_sgl -#define galahad_ssids_cpu_destroy_symbolic_subtree galahad_ssids_cpu_destroy_symbolic_subtree_sgl -#define galahad_ssids_cpu_create_num_subtree galahad_ssids_cpu_create_num_subtree_sgl -#define galahad_ssids_cpu_destroy_num_subtree galahad_ssids_cpu_destroy_num_subtree_sgl -#define galahad_ssids_cpu_subtree_solve_fwd galahad_ssids_cpu_subtree_solve_fwd_sgl -#define galahad_ssids_cpu_subtree_solve_diag galahad_ssids_cpu_subtree_solve_diag_sgl -#define galahad_ssids_cpu_subtree_solve_diag_bwd galahad_ssids_cpu_subtree_solve_diag_bwd_sgl -#define galahad_ssids_cpu_subtree_solve_bwd galahad_ssids_cpu_subtree_solve_bwd_sgl -#define galahad_ssids_cpu_subtree_enquire galahad_ssids_cpu_subtree_enquire_sgl -#define galahad_ssids_cpu_subtree_alter galahad_ssids_cpu_subtree_alter_sgl -#define galahad_ssids_cpu_subtree_get_contrib galahad_ssids_cpu_subtree_get_contrib_sgl -#define galahad_ssids_cpu_subtree_free_contrib galahad_ssids_cpu_subtree_free_contrib_sgl -#define ldlt_app_internal ldlt_app_internal_sgl -#define ldlt_app_factor_mem_required ldlt_app_factor_mem_required_sgl -#elif REAL_128 -#define ldlt_app_factor ldlt_app_factor_qul -#define ldlt_app_solve_fwd ldlt_app_solve_fwd_qul -#define ldlt_app_solve_diag ldlt_app_solve_diag_qul -#define ldlt_app_solve_bwd ldlt_app_solve_bwd_qul -#define ldlt_tpp_factor ldlt_tpp_factor_qul -#define ldlt_tpp_solve_fwd ldlt_tpp_solve_fwd_qul -#define ldlt_tpp_solve_diag ldlt_tpp_solve_diag_qul -#define ldlt_tpp_solve_bwd ldlt_tpp_solve_bwd_qul -#define ldlt_nopiv_factor ldlt_nopiv_factor_qul -#define ldlt_nopiv_solve_fwd ldlt_nopiv_solve_fwd_qul -#define ldlt_nopiv_solve_diag ldlt_nopiv_solve_diag_qul -#define ldlt_nopiv_solve_bwd ldlt_nopiv_solve_bwd_qul -#define cholesky_factor cholesky_factor_qul -#define cholesky_solve_fwd cholesky_solve_fwd_qul -#define cholesky_solve_bwd cholesky_solve_bwd_qul -#define galahad_ssids_contrib_get_data galahad_ssids_contrib_get_data_quadruple -#define galahad_ssids_contrib_free galahad_ssids_contrib_free_qul -#define FAPrecisionTraits FAQuadrupleTraits -#define factor_alloc_precision factor_alloc_quadruple -#define galahad_ssids_cpu_create_symbolic_subtree galahad_ssids_cpu_create_symbolic_subtree_qul -#define galahad_ssids_cpu_destroy_symbolic_subtree galahad_ssids_cpu_destroy_symbolic_subtree_qul -#define galahad_ssids_cpu_create_num_subtree galahad_ssids_cpu_create_num_subtree_qul -#define galahad_ssids_cpu_destroy_num_subtree galahad_ssids_cpu_destroy_num_subtree_qul -#define galahad_ssids_cpu_subtree_solve_fwd galahad_ssids_cpu_subtree_solve_fwd_qul -#define galahad_ssids_cpu_subtree_solve_diag galahad_ssids_cpu_subtree_solve_diag_qul -#define galahad_ssids_cpu_subtree_solve_diag_bwd galahad_ssids_cpu_subtree_solve_diag_bwd_qul -#define galahad_ssids_cpu_subtree_solve_bwd galahad_ssids_cpu_subtree_solve_bwd_qul -#define galahad_ssids_cpu_subtree_enquire galahad_ssids_cpu_subtree_enquire_qul -#define galahad_ssids_cpu_subtree_alter galahad_ssids_cpu_subtree_alter_qul -#define galahad_ssids_cpu_subtree_get_contrib galahad_ssids_cpu_subtree_get_contrib_qul -#define galahad_ssids_cpu_subtree_free_contrib galahad_ssids_cpu_subtree_free_contrib_qul -#define ldlt_app_internal ldlt_app_internal_qul -#define ldlt_app_factor_mem_required ldlt_app_factor_mem_required_qul -#else -#define ldlt_app_factor ldlt_app_factor_dbl -#define ldlt_app_solve_fwd ldlt_app_solve_fwd_dbl -#define ldlt_app_solve_diag ldlt_app_solve_diag_dbl -#define ldlt_app_solve_bwd ldlt_app_solve_bwd_dbl -#define ldlt_tpp_factor ldlt_tpp_factor_dbl -#define ldlt_tpp_solve_fwd ldlt_tpp_solve_fwd_dbl -#define ldlt_tpp_solve_diag ldlt_tpp_solve_diag_dbl -#define ldlt_tpp_solve_bwd ldlt_tpp_solve_bwd_dbl -#define ldlt_nopiv_factor ldlt_nopiv_factor_dbl -#define ldlt_nopiv_solve_fwd ldlt_nopiv_solve_fwd_dbl -#define ldlt_nopiv_solve_diag ldlt_nopiv_solve_diag_dbl -#define ldlt_nopiv_solve_bwd ldlt_nopiv_solve_bwd_dbl -#define cholesky_factor cholesky_factor_dbl -#define cholesky_solve_fwd cholesky_solve_fwd_dbl -#define cholesky_solve_bwd cholesky_solve_bwd_dbl -#define galahad_ssids_contrib_get_data galahad_ssids_contrib_get_data_double -#define galahad_ssids_contrib_free galahad_ssids_contrib_free_dbl -#define FAPrecisionTraits FADoubleTraits -#define factor_alloc_precision factor_alloc_double -#define galahad_ssids_cpu_create_symbolic_subtree galahad_ssids_cpu_create_symbolic_subtree_dbl -#define galahad_ssids_cpu_destroy_symbolic_subtree galahad_ssids_cpu_destroy_symbolic_subtree_dbl -#define galahad_ssids_cpu_create_num_subtree galahad_ssids_cpu_create_num_subtree_dbl -#define galahad_ssids_cpu_destroy_num_subtree galahad_ssids_cpu_destroy_num_subtree_dbl -#define galahad_ssids_cpu_subtree_solve_fwd galahad_ssids_cpu_subtree_solve_fwd_dbl -#define galahad_ssids_cpu_subtree_solve_diag galahad_ssids_cpu_subtree_solve_diag_dbl -#define galahad_ssids_cpu_subtree_solve_diag_bwd galahad_ssids_cpu_subtree_solve_diag_bwd_dbl -#define galahad_ssids_cpu_subtree_solve_bwd galahad_ssids_cpu_subtree_solve_bwd_dbl -#define galahad_ssids_cpu_subtree_enquire galahad_ssids_cpu_subtree_enquire_dbl -#define galahad_ssids_cpu_subtree_alter galahad_ssids_cpu_subtree_alter_dbl -#define galahad_ssids_cpu_subtree_get_contrib galahad_ssids_cpu_subtree_get_contrib_dbl -#define galahad_ssids_cpu_subtree_free_contrib galahad_ssids_cpu_subtree_free_contrib_dbl -#define ldlt_app_internal ldlt_app_internal_dbl -#define ldlt_app_factor_mem_required ldlt_app_factor_mem_required_dbl -#endif -#endif - -#ifdef INTEGER_64 -#define host_gemm host_gemm_64 -#define lapack_potrf lapack_potrf_64 -#define host_syrk host_syrk_64 -#define host_trsv host_trsv_64 -#define host_trsm host_trsm_64 -#define gemv gemv_64 -#endif - -#ifdef INTEGER_64 -#define align_lda align_lda_64 -#define SymbolicSubtree SymbolicSubtree_64 -#define SymbolicNode SymbolicNode_64 -#define SmallLeafSymbolicSubtree SmallLeafSymbolicSubtree_64 -#define NumericSubtree NumericSubtree_64 -#define NumericNode NumericNode_64 -#define SmallLeafNumericSubtree SmallLeafNumericSubtree_64 -#define BuddyAllocator BuddyAllocator_64 -#define Page Page_64 -#define Table Table_64 -#define NumericSubtree NumericSubtree_64 -#define now now_64 -#define guess_core guess_core_64 -#define Task Task_64 -#define setState setState_64 -#define Workspace Workspace_64 -#define ThreadStats ThreadStats_64 -#define SingularError SingularError_64 -#define AppendAlloc AppendAlloc_64 -#define Page Page_64 -#define Pool Pool_64 -#define SimdVec SimdVec_64 -#define block_ldlt_internal block_ldlt_internal_64 -#endif diff --git a/man/man3/psls_c.3 b/man/man3/psls_c.3 index 329935172a..2fea64ff6d 100644 --- a/man/man3/psls_c.3 +++ b/man/man3/psls_c.3 @@ -99,7 +99,7 @@ The factorization methods used by the GALAHAD package SLS in conjunction with so (ignore next paragraph - doxygen bug!) .PP -External solver characteristicssolver factorization indefinite A out-of-core parallelised \fCSILS/MA27\fP multifrontal yes no no \fCHSL_MA57\fP multifrontal yes no no \fCHSL_MA77\fP multifrontal yes yes OpenMP core \fCHSL_MA86\fP left-looking yes no OpenMP fully \fCHSL_MA87\fP left-looking no no OpenMP fully \fCHSL_MA97\fP multifrontal yes no OpenMP core \fCSSIDS\fP multifrontal yes no CUDA core \fCMUMPS\fP multifrontal yes optionally MPI \fCPARDISO\fP left-right-looking yes no OpenMP fully \fCMKL_PARDISO\fP left-right-looking yes optionally OpenMP fully \fCPaStix\fP left-right-looking yes no OpenMP fully \fCWSMP\fP left-right-looking yes no OpenMP fully \fCPOTR\fP dense no no with parallel LAPACK \fCSYTR\fP dense yes no with parallel LAPACK \fCPBTR\fP dense band no no with parallel LAPACK +External solver characteristicssolver factorization indefinite A out-of-core parallelised \fCSILS/MA27\fP multifrontal yes no no \fCHSL_MA57\fP multifrontal yes no no \fCHSL_MA77\fP multifrontal yes yes OpenMP core \fCHSL_MA86\fP left-looking yes no OpenMP fully \fCHSL_MA87\fP left-looking no no OpenMP fully \fCHSL_MA97\fP multifrontal yes no OpenMP core \fCSLBLT\fP multifrontal yes no OpenMP core \fCMUMPS\fP multifrontal yes optionally MPI \fCPARDISO\fP left-right-looking yes no OpenMP fully \fCMKL_PARDISO\fP left-right-looking yes optionally OpenMP fully \fCPaStix\fP left-right-looking yes no OpenMP fully \fCWSMP\fP left-right-looking yes no OpenMP fully \fCPOTR\fP dense no no with parallel LAPACK \fCSYTR\fP dense yes no with parallel LAPACK \fCPBTR\fP dense band no no with parallel LAPACK .PP External solver characteristics (ooc = out-of-core factorization) @@ -111,7 +111,7 @@ External solver characteristics (ooc = out-of-core factorization) HSL_MA86 left-looking yes no OpenMP fully HSL_MA87 left-looking no no OpenMP fully HSL_MA97 multifrontal yes no OpenMP core - SSIDS multifrontal yes no CUDA core + SLBLT multifrontal yes no OpenMP core MUMPS multifrontal yes optionally MPI PARDISO left-right-looking yes no OpenMP fully MKL_PARDISO left-right-looking yes optionally OpenMP fully @@ -260,7 +260,7 @@ bool \fIspace_critical\fP if space is critical, ensure allocated arrays are no b bool \fIdeallocate_error_fatal\fP exit if any deallocation fails .br .PP -char \fIdefinite_linear_solver[31]\fP the definite linear equation solver used when \&.preconditioner = 3,4\&. Possible choices are currently: sils, ma27, ma57, ma77, ma86, ma87, ma97, ssids, mumps, pardiso, mkl_pardiso,pastix, wsmp, potr and pbtr, although only sils, potr, pbtr and, for OMP 4\&.0-compliant compilers, ssids are installed by default\&. +char \fIdefinite_linear_solver[31]\fP the definite linear equation solver used when \&.preconditioner = 3,4\&. Possible choices are currently: sils, ma27, ma57, ma77, ma86, ma87, ma97, slblt, mumps, pardiso, mkl_pardiso,pastix, wsmp, potr and pbtr, although only sils, potr, pbtr and, for OMP 4\&.0-compliant compilers, slblt are installed by default\&. .br .PP char \fIprefix[31]\fP all output lines will be prefixed by prefix(2:LEN(TRIM(\&.prefix))-1) where prefix contains the required string enclosed in quotes, e\&.g\&. 'string' or 'string' diff --git a/man/man3/sls_c.3 b/man/man3/sls_c.3 index ed660f3fc6..b4a7368a3a 100644 --- a/man/man3/sls_c.3 +++ b/man/man3/sls_c.3 @@ -26,8 +26,6 @@ galahad_sls.h .br \fC#include 'hsl_ma97\&.h'\fP .br -\fC#include 'spral_ssids\&.h'\fP -.br \fC#include 'hsl_mc64\&.h'\fP .br \fC#include 'hsl_mc68\&.h'\fP @@ -85,7 +83,7 @@ galahad_sls.h .SS "Purpose" This package \fB solves dense or sparse symmetric systems of linear equations\fP using variants of Gaussian elimination\&. Given a sparse symmetric n \\times n matrix A, and an n-vector b, this subroutine solves the system A x = b\&. The matrix A need not be definite\&. .PP -The package provides a common interface to a variety of well-known solvers from HSL and elsewhere\&. Currently supported solvers include \fCMA27/SILS\fP, \fCHSL_MA57\fP, \fCHSL_MA77\fP, \fCHSL_MA86\fP, \fCHSL_MA87\fP and \fCHSL_MA97\fP from HSL, \fCSSIDS\fP from SPRAL, \fCMUMPS\fP from Mumps Technologies, \fCPARDISO\fP both from the Pardiso Project and Intel's MKL, \fCPaStix\fP from Inria and \fCWSMP\fP from the IBM alpha Works, as well as \fCPOTR\fP, \fCSYTR\fP and \fCSBTR\fP from LAPACK\&. Note that \fB the solvers themselves do not form part of this package and must be obtained separately\&.\fP Dummy instances are provided for solvers that are unavailable\&. Also note that additional flexibility may be obtained by calling the solvers directly rather that via this package\&. +The package provides a common interface to a variety of well-known solvers from HSL and elsewhere\&. Currently supported solvers include \fCMA27/SILS\fP, \fCHSL_MA57\fP, \fCHSL_MA77\fP, \fCHSL_MA86\fP, \fCHSL_MA87\fP and \fCHSL_MA97\fP from HSL, \fCSLBLT\fP from GALAHAD, \fCMUMPS\fP from Mumps Technologies, \fCPARDISO\fP both from the Pardiso Project and Intel's MKL, \fCPaStix\fP from Inria and \fCWSMP\fP from the IBM alpha Works, as well as \fCPOTR\fP, \fCSYTR\fP and \fCSBTR\fP from LAPACK\&. Note that \fB the solvers themselves do not form part of this package and must be obtained separately\&.\fP Dummy instances are provided for solvers that are unavailable\&. Also note that additional flexibility may be obtained by calling the solvers directly rather that via this package\&. .SS "Authors" N\&. I\&. M\&. Gould, STFC-Rutherford Appleton Laboratory, England\&. .PP @@ -102,7 +100,7 @@ The key features of the external solvers supported by sls are given in the follo (ignore next paragraph - doxygen bug!) .PP -External solver characteristicssolver factorization indefinite A out-of-core parallelised \fCSILS/MA27\fP multifrontal yes no no \fCHSL_MA57\fP multifrontal yes no no \fCHSL_MA77\fP multifrontal yes yes OpenMP core \fCHSL_MA86\fP left-looking yes no OpenMP fully \fCHSL_MA87\fP left-looking no no OpenMP fully \fCHSL_MA97\fP multifrontal yes no OpenMP core \fCSSIDS\fP multifrontal yes no CUDA core \fCMUMPS\fP multifrontal yes optionally MPI \fCPARDISO\fP left-right-looking yes no OpenMP fully \fCMKL_PARDISO\fP left-right-looking yes optionally OpenMP fully \fCPaStix\fP left-right-looking yes no OpenMP fully \fCWSMP\fP left-right-looking yes no OpenMP fully \fCPOTR\fP dense no no with parallel LAPACK \fCSYTR\fP dense yes no with parallel LAPACK \fCPBTR\fP dense band no no with parallel LAPACK +External solver characteristicssolver factorization indefinite A out-of-core parallelised \fCSILS/MA27\fP multifrontal yes no no \fCHSL_MA57\fP multifrontal yes no no \fCHSL_MA77\fP multifrontal yes yes OpenMP core \fCHSL_MA86\fP left-looking yes no OpenMP fully \fCHSL_MA87\fP left-looking no no OpenMP fully \fCHSL_MA97\fP multifrontal yes no OpenMP core \fCSLBLT\fP multifrontal yes no OpenMP core \fCMUMPS\fP multifrontal yes optionally MPI \fCPARDISO\fP left-right-looking yes no OpenMP fully \fCMKL_PARDISO\fP left-right-looking yes optionally OpenMP fully \fCPaStix\fP left-right-looking yes no OpenMP fully \fCWSMP\fP left-right-looking yes no OpenMP fully \fCPOTR\fP dense no no with parallel LAPACK \fCSYTR\fP dense yes no with parallel LAPACK \fCPBTR\fP dense band no no with parallel LAPACK .PP External solver characteristics (ooc = out-of-core factorization) @@ -114,7 +112,7 @@ External solver characteristics (ooc = out-of-core factorization) HSL_MA86 left-looking yes no OpenMP fully HSL_MA87 left-looking no no OpenMP fully HSL_MA97 multifrontal yes no OpenMP core - SSIDS multifrontal yes no CUDA core + SLBLT multifrontal yes no OpenMP core MUMPS multifrontal yes optionally MPI PARDISO left-right-looking yes no OpenMP fully MKL_PARDISO left-right-looking yes optionally OpenMP fully @@ -134,8 +132,6 @@ The solvers \fCHSL_MA57\fP, \fCHSL_MA77\fP, \fCHSL_MA86\fP, \fCHSL_MA87\fP and \ .PP http://hsl.rl.ac.uk .PP -The solver \fCSSIDS\fP is from the SPRAL sparse-matrix collection, and is available as part of GALAHAD\&. -.PP The solver \fCMUMPS\fP is available from Mumps Technologies in France, and version 5\&.5\&.1 or above is sufficient\&. To obtain \fCMUMPS\fP, see .PP https://mumps-solver.org \&. @@ -666,7 +662,7 @@ struct ma87_info \fIma87_info\fP the output structure from ma87 struct ma97_info \fIma97_info\fP the output structure from ma97 .br .PP -struct spral_ssids_inform \fIssids_inform\fP the output structure from ssids +struct slblt_inform \fIslblt_inform\fP the output structure from slblt .br .PP int \fImc61_info[10]\fP the integer and real output arrays from mc61 @@ -738,7 +734,7 @@ Select solver, set default control values and initialize private data .PP \fBParameters\fP .RS 4 -\fIsolver\fP is a one-dimensional array of type char that specifies the \fBsolver package \fP that should be used to factorize the matrix A\&. It should be one of 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'ssids', 'mumps', 'pardiso', 'mkl pardiso', 'pastix', 'wsmp', 'potr', 'sytr' or 'pbtr'; lower or upper case variants are allowed\&. +\fIsolver\fP is a one-dimensional array of type char that specifies the \fBsolver package \fP that should be used to factorize the matrix A\&. It should be one of 'sils', 'ma27', 'ma57', 'ma77', 'ma86', 'ma87', 'ma97', 'slblt', 'mumps', 'pardiso', 'mkl pardiso', 'pastix', 'wsmp', 'potr', 'sytr' or 'pbtr'; lower or upper case variants are allowed\&. .br \fIdata\fP holds private internal data .br diff --git a/meson.build b/meson.build index 13f5cbf201..5a56149fcc 100644 --- a/meson.build +++ b/meson.build @@ -1,6 +1,6 @@ project( 'GALAHAD', - 'c', 'cpp', 'fortran', + 'c', 'fortran', version: '5.5.1', license: 'BSD-3', meson_version: '>= 0.63.0', @@ -10,12 +10,10 @@ project( 'default_library=shared', 'warning_level=0', 'c_std=c99', - 'cpp_std=c++11', ], ) cc = meson.get_compiler('c') -cxx = meson.get_compiler('cpp') fc = meson.get_compiler('fortran') fc_compiler = find_program(fc.cmd_array()) fs = import('fs') @@ -27,12 +25,6 @@ if fs.is_samepath(get_option('prefix'), meson.project_source_root()) error('The option --prefix must not be the GALAHAD source directory.') endif -if host_machine.system() == 'darwin' - if cxx.get_id() == 'clang' and fc.get_id() == 'gcc' - error('On macOS, building GALAHAD with gfortran and clang++ is not supported. Please use g++ as the C++ compiler.') - endif -endif - # Remove messages about deprecated Intel compilers if cc.get_id() == 'intel' add_global_arguments('-diag-disable=10441', language : 'c') @@ -42,14 +34,6 @@ if cc.get_id() == 'intel-cl' add_global_arguments('/Qdiag-disable=10441', language : 'c') add_global_link_arguments('/Qdiag-disable=10441', language : 'c') endif -if cxx.get_id() == 'intel' - add_global_arguments('-diag-disable=10441', language : 'cpp') - add_global_link_arguments('-diag-disable=10441', language : 'cpp') -endif -if cxx.get_id() == 'intel-cl' - add_global_arguments('/Qdiag-disable=10441', language : 'cpp') - add_global_link_arguments('/Qdiag-disable=10441', language : 'cpp') -endif # Recognise old non-standard double complex intrinsics if fc.get_id() == 'nagfor' @@ -93,7 +77,6 @@ build_quadruple = get_option('quadruple') build_tests = get_option('tests') build_examples = get_option('examples') build_binaries = get_option('binaries') -build_ssids = get_option('ssids') build_openmp = get_option('openmp') libblas_name = get_option('libblas') @@ -109,7 +92,6 @@ libasl_name = get_option('libasl') libcutest_single_name = get_option('libcutest_single') libcutest_double_name = get_option('libcutest_double') libcutest_quadruple_name = get_option('libcutest_quadruple') -libhwloc_name = get_option('libhwloc') libmumps_path = get_option('libmumps_path') libblas_path = get_option('libblas_path') @@ -121,9 +103,7 @@ libasl_path = get_option('libasl_path') libpastixf_path = get_option('libpastixf_path') libspmf_path = get_option('libspmf_path') libcutest_path = get_option('libcutest_path') -libhwloc_path = get_option('libhwloc_path') -libhwloc_include = include_directories(get_option('libhwloc_include')) libasl_include = include_directories(get_option('libasl_include')) libhsl_modules = include_directories(get_option('libhsl_modules')) libcutest_modules = include_directories(get_option('libcutest_modules')) @@ -142,9 +122,7 @@ libspmf = fc.find_library(libspmf_name, dirs : libspmf_path, required : false) libsmumps = fc.find_library(libsmumps_name, dirs : libmumps_path, required : false) libdmumps = fc.find_library(libdmumps_name, dirs : libmumps_path, required : false) libasl = fc.find_library(libasl_name, dirs : libasl_path, required : false) -libhwloc = fc.find_library(libhwloc_name, dirs : libhwloc_path, required : false) lm = cc.find_library('m', required : false) -has_hwloch = cc.has_header('hwloc.h', include_directories : libhwloc_include) # Quadmath if build_quadruple @@ -185,42 +163,31 @@ if build_openmp add_global_arguments('/Qopenmp', language : 'c') endif - if cxx.get_id() == 'nvidia_hpc' - add_global_arguments('-mp', language : 'cpp') - elif cxx.get_id() == 'gcc' or cxx.get_id() == 'clang' or cxx.get_id() == 'clang-cl' - add_global_arguments('-fopenmp', language : 'cpp') - elif cxx.get_id() == 'intel' or cxx.get_id() == 'intel-llvm' - add_global_arguments('-qopenmp', language : 'cpp') - elif cxx.get_id() == 'intel-cl' or cxx.get_id() == 'intel-llvm-cl' - add_global_arguments('/Qopenmp', language : 'cpp') - endif - lomp = '-lgomp' - if cxx.get_id() == 'intel' or cxx.get_id() == 'intel-llvm' + if cc.get_id() == 'intel' or cc.get_id() == 'intel-llvm' lomp = '-liomp5' endif - if cxx.get_id() == 'nvidia_hpc' + if cc.get_id() == 'nvidia_hpc' lomp = '-lomp' endif if host_machine.system() == 'darwin' or host_machine.system() == 'freebsd' - if cxx.get_id() == 'clang' + if cc.get_id() == 'clang' lomp = '-lomp' endif endif add_global_link_arguments(lomp, language : 'fortran') add_global_link_arguments(lomp, language : 'c') - add_global_link_arguments(lomp, language : 'cpp') endif libgalahad_single_deps = [libsmumps, libcutest_single, libblas, liblapack, libhsl, libwsmp, libpardiso, libpastixf, libspmf, - libasl, libhwloc] + libasl] libgalahad_double_deps = [libdmumps, libcutest_double, libblas, liblapack, libhsl, libwsmp, libpardiso, libpastixf, libspmf, - libasl, libhwloc] + libasl] -libgalahad_quadruple_deps = [libcutest_quadruple, libhsl, libhwloc, libquadmath] +libgalahad_quadruple_deps = [libcutest_quadruple, libhsl, libquadmath] # BLAS and LAPACK libblas_src = [] @@ -262,8 +229,7 @@ galahad_ampl_headers = [] libgalahad_cutest_src = [] galahad_cutest_binaries = [] -# C and C++ files required by GALAHAD -libgalahad_cpp_src = [] +# C files required by GALAHAD libgalahad_cc_src = [] # Fortran examples and tests @@ -284,20 +250,7 @@ libgalahad_include = [include_directories('include'), include_directories('src/nodend/metis51/include'), include_directories('src/nodend/metis52/include'), include_directories('src/ampl')] -libgalahad_include = libgalahad_include + libhwloc_include + libasl_include + libhsl_modules + libcutest_modules - -if host_machine.system() == 'linux' - add_global_arguments('-DSPRAL_HAVE_SCHED_GETCPU', language : 'cpp') -else - add_global_arguments('-DSPRAL_NO_SCHED_GETCPU', language : 'cpp') -endif - -# HWLOC -if libhwloc.found() and has_hwloch - add_global_arguments('-DSPRAL_HAVE_HWLOC', language : 'cpp') -else - add_global_arguments('-DSPRAL_NO_HWLOC', language : 'cpp') -endif +libgalahad_include = libgalahad_include + libasl_include + libhsl_modules + libcutest_modules # HSL if libhsl.found() @@ -446,7 +399,6 @@ subdir('src/gls') subdir('src/gltr') subdir('src/hash') subdir('src/icfs') -subdir('src/hw') subdir('src/ir') subdir('src/l1qp') subdir('src/l2rt') @@ -504,14 +456,15 @@ subdir('src/scu') subdir('src/sec') subdir('src/sha') subdir('src/sils') +subdir('src/slblt') subdir('src/slls') subdir('src/sllsb') subdir('src/sls') subdir('src/snls') subdir('src/ssls') -subdir('src/ssids') subdir('src/svt') subdir('src/tools') +subdir('src/topology') subdir('src/trans') subdir('src/trb') subdir('src/trek') @@ -562,7 +515,7 @@ if build_single pp_sources_f_single = gen_f_single.process(to_process_f_single) endif - sources_single = [pp_sources_single, pp_sources_f_single, libgalahad_cpp_src, libgalahad_cc_src] + sources_single = [pp_sources_single, pp_sources_f_single, libgalahad_cc_src] # if libcutest_single.found() and libasl.found() # sources_single += libgalahad_ampl_cc_src # galahad_headers += galahad_ampl_headers @@ -578,7 +531,6 @@ if build_single dependencies : libgalahad_single_deps, fortran_args : extra_args_single, c_args : extra_args_single, - cpp_args : extra_args_single, include_directories: libgalahad_include, install : true) endif @@ -620,7 +572,7 @@ if build_double pp_sources_f_double = gen_f_double.process(to_process_f_double) endif - sources_double = [pp_sources_double, pp_sources_f_double, libgalahad_cpp_src, libgalahad_cc_src] + sources_double = [pp_sources_double, pp_sources_f_double, libgalahad_cc_src] if libcutest_single.found() and libasl.found() sources_double += libgalahad_ampl_cc_src galahad_headers += galahad_ampl_headers @@ -636,7 +588,6 @@ if build_double dependencies : libgalahad_double_deps, fortran_args : extra_args_double, c_args : extra_args_double, - cpp_args : extra_args_double, include_directories: libgalahad_include, install : true) endif @@ -675,7 +626,7 @@ if build_quadruple pp_sources_f_quadruple = gen_f_quadruple.process(to_process_f_quadruple) endif - sources_quadruple = [pp_sources_quadruple, pp_sources_f_quadruple, libgalahad_cpp_src, libgalahad_cc_src] + sources_quadruple = [pp_sources_quadruple, pp_sources_f_quadruple, libgalahad_cc_src] libgalahad_quadruple_name = 'galahad_quadruple' if int64 @@ -687,7 +638,6 @@ if build_quadruple dependencies : libgalahad_quadruple_deps, fortran_args : extra_args_quadruple, c_args : extra_args_quadruple, - cpp_args : extra_args_quadruple, include_directories: libgalahad_include, install : true) endif diff --git a/meson_options.txt b/meson_options.txt index 67cbb0e8b5..0c3fbd838b 100644 --- a/meson_options.txt +++ b/meson_options.txt @@ -43,11 +43,6 @@ option('quadruple', value : false, description : 'whether to generate the quadruple precision library, tests and examples') -option('ssids', - type : 'boolean', - value : true, - description : 'whether to build ssids') - option('libblas', type : 'string', value : 'openblas', @@ -113,11 +108,6 @@ option('libasl', value : 'asl', description : 'AMPL solver library against which to link') -option('libhwloc', - type : 'string', - value : 'hwloc', - description : 'HWLOC library against which to link') - option('libblas_path', type : 'array', value : [], @@ -168,16 +158,6 @@ option('libasl_path', value : [], description : 'Additional directories to search for the AMPL solver library') -option('libhwloc_path', - type : 'array', - value : [], - description : 'Additional directory to search for the HWLOC library') - -option('libhwloc_include', - type : 'array', - value : [], - description : 'Additional directories to search for the HWLOC header files') - option('libasl_include', type : 'array', value : [], diff --git a/seds/quadruple.sed b/seds/quadruple.sed index 4d5741ce78..e92308e524 100644 --- a/seds/quadruple.sed +++ b/seds/quadruple.sed @@ -24,5 +24,5 @@ s/MC77AD/MC77AQ/g s/MC21BD/MC21BQ/g s/dmumps/qmumps/g s/DMUMPS/QMUMPS/g -s/symmetric_linear_solver = "ssids"/symmetric_linear_solver = "sytr "/g -s/definite_linear_solver = "ssids"/definite_linear_solver = "sytr "/g +s/symmetric_linear_solver = "slblt"/symmetric_linear_solver = "sytr "/g +s/definite_linear_solver = "slblt"/definite_linear_solver = "sytr "/g diff --git a/seds/single.sed b/seds/single.sed index 2db8d80d40..831477d17d 100644 --- a/seds/single.sed +++ b/seds/single.sed @@ -24,5 +24,5 @@ s/MC77AD/MC77A/g s/MC21BD/MC21B/g s/dmumps/smumps/g s/DMUMPS/SMUMPS/g -s/symmetric_linear_solver = "ssids"/symmetric_linear_solver = "sytr "/g -s/definite_linear_solver = "ssids"/definite_linear_solver = "sytr "/g +s/symmetric_linear_solver = "slblt"/symmetric_linear_solver = "sytr "/g +s/definite_linear_solver = "slblt"/definite_linear_solver = "sytr "/g diff --git a/src/README.packages b/src/README.packages index 5b114e7d6c..a35fd44d76 100644 --- a/src/README.packages +++ b/src/README.packages @@ -90,16 +90,15 @@ scu | ok | Schur-compleemnt updating for evolving linear systems sec | ok | dense secant Hessian approximation sha | beta | sparse Hessian approximation via secant equations sils | ok | modern fortran interface to ma27 +slblt | ok | sparse symmetric indefinite/definite solver slls | ok | simplex-constrained linear least-squares, projection sllsb | ok | simplex-constrained linear least-squares, interior point -snls | ok | bound-constrained nonlinear least-squares sls | ok | symmetric linear solver, multiple interfaces +snls | ok | bound-constrained nonlinear least-squares smt | ok | alias for zd11 sort | ok | various sorting algorithms space | ok | allocate and deallocate space (no doc) spec | ok | read package option data (no doc) -spral | ok | SPRAL generic tools -ssids | ok | SPRAL symmetric indefinite system solver string | ok | manipulate strings (no doc) sym | ok | associate symbols with numerical values tools | ok | simple tools (like in auxiliary, no doc) diff --git a/src/README.status b/src/README.status index dc8c29fde6..6865921000 100644 --- a/src/README.status +++ b/src/README.status @@ -91,13 +91,12 @@ scu M C- P- sec M C- P- sha M C- P- sils M C- P- +slblt sls M C+ P+ smt M sort M space M specfile M -spral -ssids string M symbols M tools M diff --git a/src/bllsb/BLLSB.template b/src/bllsb/BLLSB.template index 641ee46daf..0c5a1b0f52 100644 --- a/src/bllsb/BLLSB.template +++ b/src/bllsb/BLLSB.template @@ -50,6 +50,6 @@ ! deallocate-error-fatal no ! generate-sif-file no ! generate-qplib-file no -! symmetric-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt ! sif-file-name BLLSBPROB.SIF ! qplib-file-name BLLSBPROB.qplib diff --git a/src/bllsb/bllsb.F90 b/src/bllsb/bllsb.F90 index 99d3d5fc97..a7ec3832a1 100644 --- a/src/bllsb/bllsb.F90 +++ b/src/bllsb/bllsb.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.5 - 2026-04-01 AT 13:20 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 13:20 GMT. #include "galahad_modules.h" @@ -225,7 +225,7 @@ SUBROUTINE BLLSB_read_specfile( control, device, alt_specname ) ! deallocate-error-fatal F ! generate-sif-file F ! generate-qplib-file F -! symmetric-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt ! sif-file-name BLLSBPROB.SIF ! qplib-file-name BLLSBPROB.qplib ! output-line-prefix "" diff --git a/src/bllsb/bllsbt.F90 b/src/bllsb/bllsbt.F90 index 0ae630193a..d1dcc7d911 100644 --- a/src/bllsb/bllsbt.F90 +++ b/src/bllsb/bllsbt.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 4.3 - 2023-12-28 AT 15:50 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 15:50 GMT. #include "galahad_modules.h" PROGRAM GALAHAD_BLLSB_EXAMPLE USE GALAHAD_KINDS_precision @@ -14,7 +14,7 @@ PROGRAM GALAHAD_BLLSB_EXAMPLE INTEGER ( KIND = ip_ ) :: data_storage_type, i, status, scratch_out = 56 CHARACTER ( len = 1 ) :: st CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = REPEAT( ' ', 30 ) -! symmetric_linear_solver = 'ssids' +! symmetric_linear_solver = 'slblt' ! symmetric_linear_solver = 'ma97 ' symmetric_linear_solver = 'sytr ' diff --git a/src/bllsb/bllsbti.F90 b/src/bllsb/bllsbti.F90 index ad81b4c9f3..1f5abf51b0 100644 --- a/src/bllsb/bllsbti.F90 +++ b/src/bllsb/bllsbti.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.5 - 2026-01-25 AT 11:50 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 11:50 GMT. #include "galahad_modules.h" PROGRAM GALAHAD_BLLSB_interface_test USE GALAHAD_KINDS_precision @@ -19,7 +19,7 @@ PROGRAM GALAHAD_BLLSB_interface_test INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: X_stat CHARACTER ( len = 2 ) :: st CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = REPEAT( ' ', 30 ) -! symmetric_linear_solver = 'ssids' +! symmetric_linear_solver = 'slblt' ! symmetric_linear_solver = 'ma97 ' symmetric_linear_solver = 'sytr ' diff --git a/src/clls/CLLS.template b/src/clls/CLLS.template index db3b519a41..fc5f21997d 100644 --- a/src/clls/CLLS.template +++ b/src/clls/CLLS.template @@ -50,6 +50,6 @@ ! deallocate-error-fatal no ! generate-sif-file no ! generate-qplib-file no -! symmetric-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt ! sif-file-name CLLSPROB.SIF ! qplib-file-name CLLSPROB.qplib diff --git a/src/clls/clls.F90 b/src/clls/clls.F90 index af24443888..6b408015b3 100644 --- a/src/clls/clls.F90 +++ b/src/clls/clls.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.5 - 2026-04-01 AT 10:20 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 10:20 GMT. #include "galahad_modules.h" @@ -375,7 +375,7 @@ MODULE GALAHAD_CLLS_precision ! symmetric (indefinite) linear equation solver - CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "ssids" // & + CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "slblt" // & REPEAT( ' ', 25 ) ! name of generated SIF file containing input problem @@ -785,7 +785,7 @@ SUBROUTINE CLLS_read_specfile( control, device, alt_specname ) ! deallocate-error-fatal F ! generate-sif-file F ! generate-qplib-file F -! symmetric-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt ! sif-file-name CLLSPROB.SIF ! qplib-file-name CLLSPROB.qplib ! output-line-prefix "" diff --git a/src/clls/cllst.F90 b/src/clls/cllst.F90 index 900c2f11a8..99d1334d5c 100644 --- a/src/clls/cllst.F90 +++ b/src/clls/cllst.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.5 - 2025-04-01 AT 10:30 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 10:30 GMT. #include "galahad_modules.h" PROGRAM GALAHAD_CLLS_EXAMPLE USE GALAHAD_KINDS_precision @@ -14,7 +14,7 @@ PROGRAM GALAHAD_CLLS_EXAMPLE INTEGER ( KIND = ip_ ) :: data_storage_type, i, status, scratch_out = 56 CHARACTER ( len = 1 ) :: st CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = REPEAT( ' ', 30 ) -! symmetric_linear_solver = 'ssids' +! symmetric_linear_solver = 'slblt' ! symmetric_linear_solver = 'ma97 ' symmetric_linear_solver = 'sytr ' diff --git a/src/clls/cllsti.F90 b/src/clls/cllsti.F90 index 4446b6ee60..50a0080583 100644 --- a/src/clls/cllsti.F90 +++ b/src/clls/cllsti.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.5 - 2026-01-22 AT 11:40 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 11:40 GMT. #include "galahad_modules.h" PROGRAM GALAHAD_CLLS_interface_test USE GALAHAD_KINDS_precision @@ -22,7 +22,7 @@ PROGRAM GALAHAD_CLLS_interface_test INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: C_stat, X_stat CHARACTER ( len = 2 ) :: st CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = REPEAT( ' ', 30 ) -! symmetric_linear_solver = 'ssids' +! symmetric_linear_solver = 'slblt' ! symmetric_linear_solver = 'ma97 ' symmetric_linear_solver = 'sytr ' diff --git a/src/cro/CRO.template b/src/cro/CRO.template index 9761121aa2..b7ee684d96 100644 --- a/src/cro/CRO.template +++ b/src/cro/CRO.template @@ -8,6 +8,6 @@ ! refine-solution no ! space-critical no ! deallocate-error-fatal no -! symmetric-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt ! unsymmetric-linear-equation-solver gls ! output-line-prefix "" diff --git a/src/cro/cro.F90 b/src/cro/cro.F90 index c2f6177303..b87360d36f 100644 --- a/src/cro/cro.F90 +++ b/src/cro/cro.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.1 - 2024-11-18 AT 14:30 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 14:30 GMT. #include "galahad_modules.h" @@ -142,7 +142,7 @@ MODULE GALAHAD_CRO_precision ! indefinite linear equation solver - CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "ssids" // & + CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "slblt" // & REPEAT( ' ', 25 ) ! unsymmetric linear equation solver diff --git a/src/dps/DPS.template b/src/dps/DPS.template index 5ebf62a3ff..a3bdb5b911 100644 --- a/src/dps/DPS.template +++ b/src/dps/DPS.template @@ -12,6 +12,6 @@ ! build-goldfarb-preconditioner F ! space-critical F ! deallocate-error-fatal F -! symmetric-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt ! problem-file dps_problem.data ! output-line-prefix "" diff --git a/src/dps/dps.F90 b/src/dps/dps.F90 index 8df6c4fc45..feb9894e9a 100644 --- a/src/dps/dps.F90 +++ b/src/dps/dps.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.1 - 2024-10-04 AT 14:10 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 14:10 GMT. #include "galahad_modules.h" @@ -150,7 +150,7 @@ MODULE GALAHAD_DPS_precision ! symmetric (indefinite) linear equation solver - CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "ssids" // & + CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "slblt" // & REPEAT( ' ', 25 ) ! all output lines will be prefixed by diff --git a/src/dqp/C/dqpt2.c b/src/dqp/C/dqpt2.c index 001cf12db4..d377ec794c 100644 --- a/src/dqp/C/dqpt2.c +++ b/src/dqp/C/dqpt2.c @@ -79,8 +79,8 @@ int main(void) { printf("fdc sls ma97 %" d_ipc_ "\n", inform.fdc_inform.sls_inform.ma97_info.flag); -// printf("fdc sls ssids %" d_ipc_ "\n", -// inform.fdc_inform.sls_inform.ssids_inform.flag); +// printf("fdc sls slblt %" d_ipc_ "\n", +// inform.fdc_inform.sls_inform.slblt_inform.flag); printf("fdc sls mc61(0) %" d_ipc_ "\n", inform.fdc_inform.sls_inform.mc61_info[0]); printf("fdc sls mc61(1) %" d_ipc_ "\n", diff --git a/src/dqp/DQP.template b/src/dqp/DQP.template index 41b0a4c33e..da32ff1569 100644 --- a/src/dqp/DQP.template +++ b/src/dqp/DQP.template @@ -36,8 +36,8 @@ ! space-critical no ! deallocate-error-fatal no ! generate-sif-file no -! symmetric-linear-equation-solver ssids -! definite-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt +! definite-linear-equation-solver slblt ! unsymmetric-linear-equation-solver gls ! sif-file-name DQPPROB.SIF ! output-line-prefix "" diff --git a/src/dqp/dqp.F90 b/src/dqp/dqp.F90 index a1f06245f4..0aa092b8b3 100644 --- a/src/dqp/dqp.F90 +++ b/src/dqp/dqp.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.1 - 2024-10-04 AT 14:10 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 14:10 GMT. #include "galahad_modules.h" @@ -350,12 +350,12 @@ MODULE GALAHAD_DQP_precision ! indefinite linear equation solver set in symmetric_linear_solver - CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "ssids" // & + CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "slblt" // & REPEAT( ' ', 25 ) ! definite linear equation solver - CHARACTER ( LEN = 30 ) :: definite_linear_solver = "ssids" // & + CHARACTER ( LEN = 30 ) :: definite_linear_solver = "slblt" // & REPEAT( ' ', 25 ) ! unsymmetric linear equation solver diff --git a/src/dum/C/ssids_ciface.F90 b/src/dum/C/ssids_ciface.F90 deleted file mode 100644 index c2ec7abe31..0000000000 --- a/src/dum/C/ssids_ciface.F90 +++ /dev/null @@ -1,207 +0,0 @@ -! THIS VERSION: GALAHAD 5.4 - 2025-11-29 AT 13:30 GMT - -#ifdef REAL_32 -#ifdef INTEGER_64 -#define GALAHAD_KINDS_precision GALAHAD_KINDS_single_64 -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_single_64 -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_single_ciface_64 -#define GALAHAD_NODEND_precision_ciface GALAHAD_NODEND_single_ciface_64 -#else -#define GALAHAD_KINDS_precision GALAHAD_KINDS_single -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_single -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_single_ciface -#define GALAHAD_NODEND_precision_ciface GALAHAD_NODEND_single_ciface -#endif -#elif REAL_128 -#ifdef INTEGER_64 -#define GALAHAD_KINDS_precision GALAHAD_KINDS_quadruple_64 -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_quadruple_64 -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_quadruple_ciface_64 -#define GALAHAD_NODEND_precision_ciface GALAHAD_NODEND_quadruple_ciface_64 -#else -#define GALAHAD_KINDS_precision GALAHAD_KINDS_quadruple -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_quadruple -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_quadruple_ciface -#define GALAHAD_NODEND_precision_ciface GALAHAD_NODEND_quadruple_ciface -#endif -#else -#ifdef INTEGER_64 -#define GALAHAD_KINDS_precision GALAHAD_KINDS_double_64 -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_double_64 -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_double_ciface_64 -#define GALAHAD_NODEND_precision_ciface GALAHAD_NODEND_double_ciface_64 -#else -#define GALAHAD_KINDS_precision GALAHAD_KINDS_double -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_double -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_double_ciface -#define GALAHAD_NODEND_precision_ciface GALAHAD_NODEND_double_ciface -#endif -#endif - -#include "galahad_cfunctions.h" - -!-*-*-*-*-*-*-*- G A L A H A D _ S S I D S C I N T E R F A C E -*-*-*-*-*- - -! Copyright reserved, Gould/Orban/Toint, for GALAHAD productions -! Principal authors: Jaroslav Fowkes & Nick Gould - -! History - -! originally released GALAHAD Version 3.4. January 3rd 2022 - -! For full documentation, see -! http://galahad.rl.ac.uk/galahad-www/specs.html - -! C interface module to GALAHAD_SSIDS types and interfaces - - MODULE GALAHAD_SSIDS_precision_ciface - USE GALAHAD_KINDS_precision - USE GALAHAD_SSIDS_precision, ONLY : f_ssids_control_type & - => SSIDS_control_type, & - f_ssids_inform_type & - => SSIDS_inform_type - USE GALAHAD_NODEND_precision_ciface, ONLY: & - nodend_inform_type, nodend_control_type, & - copy_nodend_control_in => copy_control_in, & - copy_nodend_control_out => copy_control_out, & - copy_nodend_inform_out => copy_inform_out - - IMPLICIT NONE - -!------------------------------------------------- -! D e r i v e d t y p e d e f i n i t i o n s -!------------------------------------------------- - - TYPE, BIND( C ) :: ssids_control_type - INTEGER ( KIND = ipc_ ) :: array_base - INTEGER ( KIND = ipc_ ) :: print_level - INTEGER ( KIND = ipc_ ) :: unit_diagnostics - INTEGER ( KIND = ipc_ ) :: unit_error - INTEGER ( KIND = ipc_ ) :: unit_warning - INTEGER ( KIND = ipc_ ) :: ordering - INTEGER ( KIND = ipc_ ) :: nemin - LOGICAL ( KIND = C_BOOL ) :: ignore_numa - LOGICAL ( KIND = C_BOOL ) :: use_gpu - LOGICAL ( KIND = C_BOOL ) :: gpu_only - INTEGER ( KIND = longc_ ) :: min_gpu_work - REAL ( KIND = spc_ ) :: max_load_inbalance - REAL ( KIND = spc_ ) :: gpu_perf_coeff - INTEGER ( KIND = ipc_ ) :: scaling - INTEGER ( KIND = longc_ ) :: small_subtree_threshold - INTEGER ( KIND = ipc_ ) :: cpu_block_size - LOGICAL ( KIND = C_BOOL ) :: action - INTEGER ( KIND = ipc_ ) :: pivot_method - REAL ( KIND = rpc_ ) :: small - REAL ( KIND = rpc_ ) :: u - TYPE ( nodend_control_type ) :: nodend_control - INTEGER ( KIND = ipc_ ) :: nstream - REAL ( KIND = rpc_ ) :: multiplier -! type(auction_control) :: auction - REAL ( KIND = rpc_ ) :: min_loadbalance -! character(len=:), allocatable :: rb_dump - INTEGER ( KIND = ipc_ ) :: failed_pivot_method - END TYPE ssids_control_type - - TYPE, BIND( C ) :: ssids_inform_type - INTEGER ( KIND = ipc_ ) :: flag - INTEGER ( KIND = ipc_ ) :: matrix_dup - INTEGER ( KIND = ipc_ ) :: matrix_missing_diag - INTEGER ( KIND = ipc_ ) :: matrix_outrange - INTEGER ( KIND = ipc_ ) :: matrix_rank - INTEGER ( KIND = ipc_ ) :: maxdepth - INTEGER ( KIND = ipc_ ) :: maxfront - INTEGER ( KIND = ipc_ ) :: maxsupernode - INTEGER ( KIND = ipc_ ) :: num_delay - INTEGER ( KIND = longc_ ) :: num_factor - INTEGER ( KIND = longc_ ) :: num_flops - INTEGER ( KIND = ipc_ ) :: num_neg - INTEGER ( KIND = ipc_ ) :: num_sup - INTEGER ( KIND = ipc_ ) :: num_two - INTEGER ( KIND = ipc_ ) :: stat -! type(auction_inform) :: auction - INTEGER ( KIND = ipc_ ) :: cuda_error - INTEGER ( KIND = ipc_ ) :: cublas_error - TYPE ( nodend_inform_type ) :: nodend_inform - INTEGER ( KIND = ipc_ ) :: not_first_pass - INTEGER ( KIND = ipc_ ) :: not_second_pass - INTEGER ( KIND = ipc_ ) :: nparts - INTEGER ( KIND = longc_ ) :: cpu_flops - INTEGER ( KIND = longc_ ) :: gpu_flops - END TYPE ssids_inform_type - -!---------------------- -! P r o c e d u r e s -!---------------------- - - CONTAINS - -! copy C control parameters to fortran - - SUBROUTINE copy_control_in( ccontrol, fcontrol, cindexed ) - TYPE ( ssids_control_type ), INTENT( IN ) :: ccontrol - TYPE ( f_ssids_control_type ), INTENT( OUT ) :: fcontrol - LOGICAL, INTENT( OUT ) :: cindexed - - cindexed = ccontrol%array_base == 0 - fcontrol%print_level = ccontrol%print_level - fcontrol%unit_diagnostics = ccontrol%unit_diagnostics - fcontrol%unit_error = ccontrol%unit_error - fcontrol%unit_warning = ccontrol%unit_warning - fcontrol%ordering = ccontrol%ordering - fcontrol%nemin = ccontrol%nemin - fcontrol%ignore_numa = ccontrol%ignore_numa - fcontrol%use_gpu = ccontrol%use_gpu - fcontrol%gpu_only = ccontrol%gpu_only - fcontrol%min_gpu_work = ccontrol%min_gpu_work - fcontrol%max_load_inbalance = ccontrol%max_load_inbalance - fcontrol%gpu_perf_coeff = ccontrol%gpu_perf_coeff - fcontrol%scaling = ccontrol%scaling - fcontrol%small_subtree_threshold = ccontrol%small_subtree_threshold - fcontrol%cpu_block_size = ccontrol%cpu_block_size - fcontrol%action = ccontrol%action - fcontrol%pivot_method = ccontrol%pivot_method - fcontrol%small = ccontrol%small - fcontrol%u = ccontrol%u - CALL copy_nodend_control_in( ccontrol%nodend_control, & - fcontrol%nodend_control ) - fcontrol%nstream = ccontrol%nstream - fcontrol%multiplier = ccontrol%multiplier - fcontrol%min_loadbalance = REAL( ccontrol%min_loadbalance ) - fcontrol%failed_pivot_method = ccontrol%failed_pivot_method - RETURN - - END SUBROUTINE copy_control_in - -! copy fortran information parameters to C - - SUBROUTINE copy_inform_out( finform, cinform ) - TYPE ( f_ssids_inform_type ), INTENT( IN ) :: finform - TYPE ( ssids_inform_type ), INTENT( OUT ) :: cinform - - cinform%flag = finform%flag - cinform%matrix_dup = finform%matrix_dup - cinform%matrix_missing_diag = finform%matrix_missing_diag - cinform%matrix_outrange = finform%matrix_outrange - cinform%matrix_rank = finform%matrix_rank - cinform%maxdepth = finform%maxdepth - cinform%maxfront = finform%maxfront - cinform%maxsupernode = finform%maxsupernode - cinform%num_delay = finform%num_delay - cinform%num_factor = finform%num_factor - cinform%num_flops = finform%num_flops - cinform%num_neg = finform%num_neg - cinform%num_sup = finform%num_sup - cinform%num_two = finform%num_two - cinform%stat = finform%stat - cinform%cuda_error = finform%cuda_error - cinform%cublas_error = finform%cublas_error - CALL copy_nodend_inform_out( finform%nodend_inform, cinform%nodend_inform ) - cinform%not_first_pass = finform%not_first_pass - cinform%not_second_pass = finform%not_second_pass - cinform%nparts = finform%nparts - cinform%cpu_flops = finform%cpu_flops - cinform%gpu_flops = finform%gpu_flops - RETURN - - END SUBROUTINE copy_inform_out - - END MODULE GALAHAD_SSIDS_precision_ciface diff --git a/src/dum/dummy_spral.F90 b/src/dum/dummy_spral.F90 deleted file mode 100644 index 25999c3154..0000000000 --- a/src/dum/dummy_spral.F90 +++ /dev/null @@ -1,2 +0,0 @@ - SUBROUTINE GALAHAD_spral_dummy( ) - END SUBROUTINE GALAHAD_spral_dummy diff --git a/src/dum/meson.build b/src/dum/meson.build index 24c2be0089..479f125b3e 100644 --- a/src/dum/meson.build +++ b/src/dum/meson.build @@ -34,8 +34,3 @@ if not (libblas_name == 'mkl_rt' or liblapack_name == 'mkl_rt') libgalahad_double_src += files('mkl_pardiso.F90') endif libgalahad_quadruple_src += files('mkl_pardiso.F90') - -if not build_ssids - libgalahad_src += files('ssids.F90') - libgalahad_c_src += files('C/ssids_ciface.F90') -endif diff --git a/src/dum/ssids.F90 b/src/dum/ssids.F90 deleted file mode 100644 index 5d4c9d1d9b..0000000000 --- a/src/dum/ssids.F90 +++ /dev/null @@ -1,377 +0,0 @@ -! THIS VERSION: GALAHAD 5.4 - 2025-11-29 AT 13:30 GMT - -#include "galahad_modules.h" - -!-*-*-*-*-*- G A L A H A D - D U M M Y S S I D S M O D U L E -*-*-*-*-*- - - MODULE GALAHAD_SSIDS_precision - - USE, INTRINSIC :: iso_c_binding -!$ USE omp_lib - USE GALAHAD_SYMBOLS - USE GALAHAD_KINDS_precision, ONLY: ip_, ipc_, rp_, long_ - USE GALAHAD_NODEND_precision, ONLY: NODEND_control_type, & - NODEND_inform_type - - IMPLICIT NONE - - PRIVATE - PUBLIC :: SSIDS_analyse, SSIDS_analyse_coord, SSIDS_factor, & - SSIDS_solve, SSIDS_free, SSIDS_enquire_posdef, & - SSIDS_enquire_indef, SSIDS_alter - - LOGICAL, PUBLIC, PROTECTED :: ssids_available = .FALSE. - - ! Parameters - - INTEGER( KIND = ip_ ), PARAMETER :: nemin_default = 32 - INTEGER( KIND = ip_ ), PARAMETER, PUBLIC :: PIVOT_METHOD_APP_AGGRESIVE = 1 - INTEGER( KIND = ip_ ), PARAMETER, PUBLIC :: PIVOT_METHOD_APP_BLOCK = 2 - INTEGER( KIND = ip_ ), PARAMETER, PUBLIC :: PIVOT_METHOD_TPP = 3 - - INTERFACE SSIDS_analyse - MODULE PROCEDURE analyse_precision - END INTERFACE SSIDS_analyse - - INTERFACE SSIDS_analyse_coord - MODULE PROCEDURE SSIDS_analyse_coord_precision - END INTERFACE SSIDS_analyse_coord - - INTERFACE SSIDS_factor - MODULE PROCEDURE SSIDS_factor_precision - END INTERFACE SSIDS_factor - - INTERFACE SSIDS_solve - MODULE PROCEDURE SSIDS_solve_one_precision - MODULE PROCEDURE SSIDS_solve_mult_precision - END INTERFACE SSIDS_solve - - INTERFACE SSIDS_free - MODULE PROCEDURE free_akeep_precision - MODULE PROCEDURE free_fkeep_precision - MODULE PROCEDURE free_both_precision - END INTERFACE SSIDS_free - - INTERFACE SSIDS_enquire_posdef - MODULE PROCEDURE SSIDS_enquire_posdef_precision - END INTERFACE SSIDS_enquire_posdef - - INTERFACE SSIDS_enquire_indef - MODULE PROCEDURE SSIDS_enquire_indef_precision - END INTERFACE SSIDS_enquire_indef - - INTERFACE SSIDS_alter - MODULE PROCEDURE SSIDS_alter_precision - END INTERFACE SSIDS_alter - -! in ../spral/hw_topology.f90 - - TYPE :: numa_region - INTEGER( KIND = ip_ ) :: nproc !< Number of processors in region - -! list of attached GPUs - - INTEGER( KIND = ip_ ), dimension( : ), allocatable :: gpus - END TYPE numa_region - -! in scaling.f90 - - TYPE auction_options - INTEGER( KIND = ip_ ) :: max_iterations = 30000 - INTEGER( KIND = ip_ ) :: max_unchanged( 3 ) = (/ 10, 100, 100 /) - REAL :: min_proportion( 3 ) = (/ 0.90, 0.0, 0.0 /) - REAL :: eps_initial = 0.01 - END TYPE auction_options - -! in scaling.f90 - - TYPE auction_inform - INTEGER( KIND = ip_ ) :: flag = 0 - INTEGER( KIND = ip_ ) :: stat = 0 - INTEGER( KIND = ip_ ) :: matched = 0 - INTEGER( KIND = ip_ ) :: iterations = 0 - INTEGER( KIND = ip_ ) :: unmatchable = 0 - END TYPE auction_inform - -! in ssids.f90 - -! TYPE, ABSTRACT :: symbolic_subtree_base -! INTEGER( KIND = ip_ ) :: dummy -! END TYPE symbolic_subtree_base - -! TYPE, ABSTRACT :: numeric_subtree_base -! INTEGER( KIND = ip_ ) :: dummy -! END TYPE numeric_subtree_base - - TYPE symbolic_subtree_ptr - INTEGER( KIND = ip_ ) :: exec_loc -! CLASS( symbolic_subtree_base ), POINTER :: ptr - END TYPE symbolic_subtree_ptr - - TYPE numeric_subtree_ptr - INTEGER( KIND = ip_ ) :: dummy -! CLASS( numeric_subtree_base ), POINTER :: ptr - END TYPE numeric_subtree_ptr - -! in types.f90 - - TYPE, PUBLIC :: SSIDS_control_type - INTEGER( KIND = ip_ ) :: print_level = 0 - INTEGER( KIND = ip_ ) :: unit_diagnostics = 6 - INTEGER( KIND = ip_ ) :: unit_error = 6 - INTEGER( KIND = ip_ ) :: unit_warning = 6 - INTEGER( KIND = ip_ ) :: ordering = 1 - INTEGER( KIND = ip_ ) :: nemin = nemin_default - LOGICAL :: ignore_numa = .true. - LOGICAL :: use_gpu = .true. - LOGICAL :: gpu_only = .false. - INTEGER( KIND = long_ ) :: min_gpu_work = 5*10**9_long_ - REAL :: max_load_inbalance = 1.2 - REAL :: gpu_perf_coeff = 1.0 - INTEGER( KIND = ip_ ) :: scaling = 0 - INTEGER( KIND = long_ ) :: small_subtree_threshold = 4*10**6_long_ - INTEGER( KIND = ip_ ) :: cpu_block_size = 256 - LOGICAL :: action = .true. - INTEGER( KIND = ip_ ) :: pivot_method = 2 - REAL( KIND = rp_ ) :: small = 1e-20_rp_ - REAL( KIND = rp_ ) :: u = 0.01 - TYPE ( NODEND_control_type ) :: nodend_control - INTEGER( KIND = ip_ ) :: nstream = 1 ! the following are undocumented - REAL( KIND = rp_ ) :: multiplier = 1.1 -! TYPE( MS_auction_control_type ) :: auction - REAL :: min_loadbalance = 0.8 -! CHARACTER( LEN = : ), allocatable :: rb_dump - INTEGER( KIND = ip_ ) :: failed_pivot_method = 1 - END TYPE SSIDS_control_type - - TYPE, PUBLIC :: SSIDS_inform_type - INTEGER( KIND = ip_ ) :: flag = 0 - INTEGER( KIND = ip_ ) :: matrix_dup = 0 - INTEGER( KIND = ip_ ) :: matrix_missing_diag = 0 - INTEGER( KIND = ip_ ) :: matrix_outrange = 0 - INTEGER( KIND = ip_ ) :: matrix_rank = 0 - INTEGER( KIND = ip_ ) :: maxdepth - INTEGER( KIND = ip_ ) :: maxfront - INTEGER( KIND = ip_ ) :: maxsupernode = 0 - INTEGER( KIND = ip_ ) :: num_delay = 0 - INTEGER( KIND = long_ ) :: num_factor = 0_long_ - INTEGER( KIND = long_ ) :: num_flops = 0_long_ - INTEGER( KIND = ip_ ) :: num_neg = 0 - INTEGER( KIND = ip_ ) :: num_sup = 0 - INTEGER( KIND = ip_ ) :: num_two = 0 - INTEGER( KIND = ip_ ) :: stat = 0 - TYPE( auction_inform ) :: auction - INTEGER( KIND = ip_ ) :: cuda_error - INTEGER( KIND = ip_ ) :: cublas_error - TYPE( NODEND_inform_type ) :: nodend_inform - INTEGER( KIND = ip_ ) :: not_first_pass = 0 - INTEGER( KIND = ip_ ) :: not_second_pass = 0 - INTEGER( KIND = ip_ ) :: nparts = 0 - INTEGER( KIND = long_ ) :: cpu_flops = 0_long_ - INTEGER( KIND = long_ ) :: gpu_flops = 0_long_ -! CONTAINS -! PROCEDURE, pass( this ) :: flagToCharacter - END TYPE SSIDS_inform_type - -! in ssids.f90 - - TYPE, PUBLIC :: SSIDS_akeep_type - LOGICAL :: check - INTEGER( KIND = ip_ ) :: n - INTEGER( KIND = ip_ ) :: ne - INTEGER( KIND = ip_ ) :: nnodes = - 1 - INTEGER( KIND = ip_ ) :: nparts - INTEGER( KIND = ip_ ), dimension( : ), allocatable :: part - TYPE( symbolic_subtree_ptr ), dimension( : ), allocatable :: subtree - INTEGER( KIND = ip_ ), dimension( : ), allocatable :: contrib_ptr - INTEGER( KIND = ip_ ), dimension( : ), allocatable :: contrib_idx - INTEGER( KIND = ipc_ ), dimension( : ), allocatable :: invp - INTEGER( KIND = ip_ ), dimension( :,: ), allocatable :: nlist - INTEGER( KIND = ip_ ), dimension( : ), allocatable :: nptr - INTEGER( KIND = ip_ ), dimension( : ), allocatable :: rlist - INTEGER( KIND = long_ ), dimension( : ), allocatable :: rptr - INTEGER( KIND = ip_ ), dimension( : ), allocatable :: sparent - INTEGER( KIND = ip_ ), dimension( : ), allocatable :: sptr - INTEGER( KIND = ip_ ), allocatable :: ptr( : ) - INTEGER( KIND = ip_ ), allocatable :: row( : ) - INTEGER( KIND = ip_ ) :: lmap - INTEGER( KIND = ip_ ), allocatable :: map( : ) - REAL( KIND = rp_ ), dimension( : ), allocatable :: scaling - TYPE( numa_region ), dimension( : ), allocatable :: topology - TYPE( SSIDS_inform_type ) :: inform - END TYPE SSIDS_akeep_type - - TYPE, PUBLIC :: SSIDS_fkeep_type - REAL( KIND = rp_ ), dimension( : ), allocatable :: scaling - LOGICAL :: pos_def - TYPE( numeric_subtree_ptr ), dimension( : ), allocatable :: subtree - TYPE( SSIDS_inform_type ) :: inform - END TYPE SSIDS_fkeep_type - - CONTAINS - - SUBROUTINE analyse_precision( check, n, ptr, row, akeep, control, inform, & - order, val, topology ) - LOGICAL, INTENT( IN ) :: check - INTEGER( KIND = ip_ ), INTENT( IN ) :: n - INTEGER( KIND = ip_ ), INTENT( IN ) :: row( : ) - INTEGER( KIND = ip_ ), INTENT( IN ) :: ptr( : ) - TYPE( SSIDS_akeep_type ), INTENT( INOUT ) :: akeep - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( out ) :: inform - INTEGER( KIND = ip_ ), optional, INTENT( INOUT ) :: order( : ) - REAL( KIND = rp_ ), optional, INTENT( IN ) :: val( : ) - TYPE( numa_region ), dimension( : ), optional, INTENT( IN ) :: topology - - IF ( control%unit_error >= 0 .AND. control%print_level > 0 ) & - WRITE( control%unit_error, & - "( ' We regret that the SSIDS package that you have selected is', /, & - & ' not available with GALAHAD for the compiler you have chosen.' )" ) - inform%flag = GALAHAD_error_unknown_solver - - END SUBROUTINE analyse_precision - - SUBROUTINE SSIDS_analyse_coord_precision( n, ne, row, col, akeep, control, & - inform, order, val, topology ) - INTEGER( KIND = ip_ ), INTENT( IN ) :: n - INTEGER( KIND = ip_ ), INTENT( IN ) :: ne - INTEGER( KIND = ip_ ), INTENT( IN ) :: row( : ) - INTEGER( KIND = ip_ ), INTENT( IN ) :: col( : ) - TYPE( SSIDS_akeep_type ), INTENT( out ) :: akeep - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( out ) :: inform - INTEGER( KIND = ip_ ), INTENT( INOUT ), optional :: order( : ) - REAL( KIND = rp_ ), optional, INTENT( IN ) :: val( : ) - TYPE( numa_region ), dimension( : ), optional, INTENT( IN ) :: topology - - IF ( control%unit_error >= 0 .AND. control%print_level > 0 ) & - WRITE( control%unit_error, & - "( ' We regret that the SSIDS package that you have selected is', /, & - & ' not available with GALAHAD for the compiler you have chosen.' )" ) - inform%flag = GALAHAD_error_unknown_solver - - END SUBROUTINE SSIDS_analyse_coord_precision - - SUBROUTINE SSIDS_factor_precision( posdef, val, akeep, fkeep, control, & - inform, scale, ptr, row ) - logical, INTENT( IN ) :: posdef - REAL( KIND = rp_ ), dimension( * ), target, INTENT( IN ) :: val - TYPE( SSIDS_akeep_type ), INTENT( IN ) :: akeep - TYPE( SSIDS_fkeep_type ), INTENT( INOUT ) :: fkeep - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( out ) :: inform - REAL( KIND = rp_ ), dimension( : ), optional, INTENT( INOUT ) :: scale - INTEGER( KIND = ip_ ), dimension( akeep%n+1 ), optional, INTENT( IN ) :: ptr - INTEGER( KIND = ip_ ), dimension( * ), optional, INTENT( IN ) :: row - - IF ( control%unit_error >= 0 .AND. control%print_level > 0 ) & - WRITE( control%unit_error, & - "( ' We regret that the SSIDS package that you have selected is', /, & - & ' not available with GALAHAD for the compiler you have chosen.' )" ) - inform%flag = GALAHAD_error_unknown_solver - - END SUBROUTINE SSIDS_factor_precision - - SUBROUTINE SSIDS_solve_one_precision( x1, akeep, fkeep, control, inform, & - job ) - REAL( KIND = rp_ ), dimension( : ), INTENT( INOUT ) :: x1 - TYPE( SSIDS_akeep_type ), INTENT( IN ) :: akeep - TYPE( SSIDS_fkeep_type ), INTENT( INOUT ) :: fkeep - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( out ) :: inform - INTEGER( KIND = ip_ ), optional, INTENT( IN ) :: job - - IF ( control%unit_error >= 0 .AND. control%print_level > 0 ) & - WRITE( control%unit_error, & - "( ' We regret that the SSIDS package that you have selected is', /, & - & ' not available with GALAHAD for the compiler you have chosen.' )" ) - inform%flag = GALAHAD_error_unknown_solver - - END SUBROUTINE SSIDS_solve_one_precision - - SUBROUTINE SSIDS_solve_mult_precision( nrhs, x, ldx, akeep, fkeep, control, & - inform, job ) - INTEGER( KIND = ip_ ), INTENT( IN ) :: nrhs - INTEGER( KIND = ip_ ), INTENT( IN ) :: ldx - REAL( KIND = rp_ ), dimension( ldx,nrhs ), INTENT( INOUT ), target :: x - TYPE( SSIDS_akeep_type ), INTENT( IN ) :: akeep - TYPE( SSIDS_fkeep_type ), INTENT( INOUT ) :: fkeep - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( out ) :: inform - INTEGER( KIND = ip_ ), optional, INTENT( IN ) :: job - - IF ( control%unit_error >= 0 .AND. control%print_level > 0 ) & - WRITE( control%unit_error, & - "( ' We regret that the SSIDS package that you have selected is', /, & - & ' not available with GALAHAD for the compiler you have chosen.' )" ) - inform%flag = GALAHAD_error_unknown_solver - - END SUBROUTINE SSIDS_solve_mult_precision - - SUBROUTINE SSIDS_enquire_posdef_precision( akeep, fkeep, control, inform, d ) - TYPE( SSIDS_akeep_type ), INTENT( IN ) :: akeep - TYPE( SSIDS_fkeep_type ), target, INTENT( IN ) :: fkeep - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( out ) :: inform - REAL( KIND = rp_ ), dimension( * ), INTENT( out ) :: d - - IF ( control%unit_error >= 0 .AND. control%print_level > 0 ) & - WRITE( control%unit_error, & - "( ' We regret that the SSIDS package that you have selected is', /, & - & ' not available with GALAHAD for the compiler you have chosen.' )" ) - inform%flag = GALAHAD_error_unknown_solver - - END SUBROUTINE SSIDS_enquire_posdef_precision - - SUBROUTINE SSIDS_enquire_indef_precision( akeep, fkeep, control, inform, & - piv_order, d ) - TYPE( SSIDS_akeep_type ), INTENT( IN ) :: akeep - TYPE( SSIDS_fkeep_type ), target, INTENT( IN ) :: fkeep - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( out ) :: inform - INTEGER( KIND = ip_ ), dimension( * ), optional, INTENT( out ) :: piv_order - REAL( KIND = rp_ ), dimension( 2,* ), optional, INTENT( out ) :: d - - IF ( control%unit_error >= 0 .AND. control%print_level > 0 ) & - WRITE( control%unit_error, & - "( ' We regret that the SSIDS package that you have selected is', /, & - & ' not available with GALAHAD for the compiler you have chosen.' )" ) - inform%flag = GALAHAD_error_unknown_solver - - END SUBROUTINE SSIDS_enquire_indef_precision - - SUBROUTINE SSIDS_alter_precision( d, akeep, fkeep, control, inform ) - REAL( KIND = rp_ ), dimension( 2, * ), INTENT( IN ) :: d - TYPE( SSIDS_akeep_type ), INTENT( IN ) :: akeep - TYPE( SSIDS_fkeep_type ), target, INTENT( INOUT ) :: fkeep - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( out ) :: inform - - IF ( control%unit_error >= 0 .AND. control%print_level > 0 ) & - WRITE( control%unit_error, & - "( ' We regret that the SSIDS package that you have selected is', /, & - & ' not available with GALAHAD for the compiler you have chosen.' )" ) - inform%flag = GALAHAD_error_unknown_solver - - END SUBROUTINE SSIDS_alter_precision - - SUBROUTINE free_akeep_precision( akeep, flag ) - TYPE( SSIDS_akeep_type ), INTENT( INOUT ) :: akeep - INTEGER( KIND = ip_ ), INTENT( out ) :: flag - flag = GALAHAD_error_unknown_solver - END SUBROUTINE free_akeep_precision - - SUBROUTINE free_fkeep_precision( fkeep, cuda_error ) - TYPE( SSIDS_fkeep_type ), INTENT( INOUT ) :: fkeep - INTEGER( KIND = ip_ ), INTENT( out ) :: cuda_error - cuda_error = GALAHAD_error_unknown_solver - END SUBROUTINE free_fkeep_precision - - SUBROUTINE free_both_precision( akeep, fkeep, cuda_error ) - TYPE( SSIDS_akeep_type ), INTENT( INOUT ) :: akeep - TYPE( SSIDS_fkeep_type ), INTENT( INOUT ) :: fkeep - INTEGER( KIND = ip_ ), INTENT( out ) :: cuda_error - cuda_error = GALAHAD_error_unknown_solver - END SUBROUTINE free_both_precision - -END MODULE GALAHAD_SSIDS_precision diff --git a/src/eqp/eqpt.F90 b/src/eqp/eqpt.F90 index f1ad36fa81..552f225c6c 100644 --- a/src/eqp/eqpt.F90 +++ b/src/eqp/eqpt.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 4.1 - 2023-02-11 AT 08:20 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 08:20 GMT. #include "galahad_modules.h" PROGRAM GALAHAD_EQP_EXAMPLE USE GALAHAD_KINDS_precision @@ -528,7 +528,7 @@ PROGRAM GALAHAD_EQP_EXAMPLE CALL EQP_initialize( data, control, info ) CALL WHICH_sls( control ) -! control%FDC_control%symmetric_linear_solver = 'ssids' +! control%FDC_control%symmetric_linear_solver = 'slblt' ! control%FDC_control%SLS_control%ordering = 0 ! control%print_level = 1 ! control%FDC_control%print_level = 3 diff --git a/src/eqp/eqpti.F90 b/src/eqp/eqpti.F90 index 2664f21150..296948277b 100644 --- a/src/eqp/eqpti.F90 +++ b/src/eqp/eqpti.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 4.1 - 2023-02-11 AT 17:00 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 17:00 GMT. #include "galahad_modules.h" PROGRAM GALAHAD_EQP_interface_test USE GALAHAD_KINDS_precision @@ -54,7 +54,7 @@ PROGRAM GALAHAD_EQP_interface_test DO data_storage_type = 1, 6 CALL EQP_initialize( data, control, inform ) CALL WHICH_sls( control ) -!control%FDC_control%symmetric_linear_solver = 'ssids' +!control%FDC_control%symmetric_linear_solver = 'slblt' !control%FDC_control%symmetric_linear_solver = 'ma57 ' !control%print_level = 2 !control%FDC_control%SLS_control%print_level = 2 diff --git a/src/fdc/FDC.template b/src/fdc/FDC.template index 0befd6b039..b975856888 100644 --- a/src/fdc/FDC.template +++ b/src/fdc/FDC.template @@ -7,6 +7,6 @@ ! scale-A no ! space-critical no ! deallocate-error-fatal no -! symmetric-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt ! unsymmetric-linear-equation-solver gls ! output-line-prefix "" diff --git a/src/fdc/fdc.F90 b/src/fdc/fdc.F90 index bd0d70ca99..376373f7f3 100644 --- a/src/fdc/fdc.F90 +++ b/src/fdc/fdc.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.2 - 2025-01-24 AT 10:00 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 10:00 GMT. #include "galahad_modules.h" @@ -122,7 +122,7 @@ MODULE GALAHAD_FDC_precision ! symmetric (indefinite) linear equation solver - CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "ssids" // & + CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "slblt" // & REPEAT( ' ', len_solver - 5 ) ! unsymmetric linear equation solver @@ -358,7 +358,7 @@ SUBROUTINE FDC_read_specfile( control, device, alt_specname ) ! scale-A F ! space-critical F ! deallocate-error-fatal F -! symmetric-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt ! unsymmetric-linear-equation-solver gls ! output-line-prefix "" ! END FDC SPECIFICATIONS (DEFAULT) @@ -873,7 +873,7 @@ SUBROUTINE FDC_find_dependent_sls( n, m, A_val, A_col, A_ptr, C, & WRITE( data%control%error, & "( A, ' ** Error return ', I0, ' from SLS_analyse' )") & prefix, inform%SLS_inform%status -! write(6,*) ' ssids flag ', inform%SLS_inform%ssids_inform%flag +! write(6,*) ' slblt flag ', inform%SLS_inform%slblt_inform%flag inform%status = GALAHAD_error_analysis ; RETURN END IF diff --git a/src/fdc/fdcs.f90 b/src/fdc/fdcs.f90 index 8515a8931c..74e225b34f 100644 --- a/src/fdc/fdcs.f90 +++ b/src/fdc/fdcs.f90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 4.0 - 20/01/2022 AT 09:30 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 09:30 GMT. PROGRAM GALAHAD_FDC_example USE GALAHAD_FDC_double ! double precision version IMPLICIT NONE @@ -19,7 +19,7 @@ PROGRAM GALAHAD_FDC_example CALL FDC_initialize( data, control, inform ) ! Initialize control parameters control%use_sls = .TRUE. control%symmetric_linear_solver = 'sytr' - control%symmetric_linear_solver = 'ssids ' + control%symmetric_linear_solver = 'slblt ' control%symmetric_linear_solver = 'ma86 ' control%print_level = 3 CALL FDC_find_dependent( n, m, A_val, A_col, A_ptr, B, n_depen, DEPEN, & diff --git a/src/fdc/fdct.F90 b/src/fdc/fdct.F90 index 84a8c683b6..76b9302753 100644 --- a/src/fdc/fdct.F90 +++ b/src/fdc/fdct.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 4.1 - 2023-01-24 AT 09:30 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 09:30 GMT. #include "galahad_modules.h" PROGRAM GALAHAD_FDC_test !! to be expanded USE GALAHAD_KINDS_precision @@ -22,7 +22,7 @@ PROGRAM GALAHAD_FDC_test !! to be expanded control%use_sls = .TRUE. control%symmetric_linear_solver = 'sytr' ! control%symmetric_linear_solver = 'ma57' - control%symmetric_linear_solver = 'ssids' + control%symmetric_linear_solver = 'slblt' CALL FDC_find_dependent( n, m, A_val, A_col, A_ptr, B, n_depen, DEPEN, & data, control, inform ) ! Check for dependencies WRITE( 6, "( ' linear solver used: ', A )" ) inform%SLS_inform%solver diff --git a/src/forthcoming/expo/expot.F90 b/src/forthcoming/expo/expot.F90 index 2c8ca273f4..efb2459dcb 100644 --- a/src/forthcoming/expo/expot.F90 +++ b/src/forthcoming/expo/expot.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.3 - 2024-06-15 AT 11:00 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 11:00 GMT. #include "galahad_modules.h" PROGRAM GALAHAD_EXPO_test_program USE GALAHAD_KINDS_precision @@ -192,8 +192,8 @@ SUBROUTINE WHICH_sls( control ) USE GALAHAD_EXPO_precision, ONLY: EXPO_control_type TYPE ( EXPO_control_type ) :: control #include "galahad_sls_defaults_ls.h" -!symmetric_linear_solver = 'ssids' -!definite_linear_solver = 'ssids' +!symmetric_linear_solver = 'slblt' +!definite_linear_solver = 'slblt' control%SSLS_control%symmetric_linear_solver = symmetric_linear_solver control%TRU_control%TRS_control%definite_linear_solver & = definite_linear_solver diff --git a/src/general/makemaster b/src/general/makemaster index 3424577b01..09758f5aad 100644 --- a/src/general/makemaster +++ b/src/general/makemaster @@ -11,7 +11,7 @@ include $(GALAHAD)/src/makedefs/definitions DUMMYS = kinds_silent clock_silent extend_silent symbols_silent \ dummy_silent cutest_dummy_silent dummy_hsl_silent dummy_hsl_c_silent \ - dummy_spral_silent blas_silent lapack_silent blas_inter_silent \ + blas_silent lapack_silent blas_inter_silent \ lapack_inter_silent hsl_inter_silent \ pardiso_silent mkl_pardiso_silent wsmp_silent \ pastix_silent mpi_silent mumps_silent umfpack_silent \ @@ -295,24 +295,6 @@ $(HCLG)(dummy_hsl_c_$(PRECIS).o): ../dum/dummy_hsl_c.F90 $(RANLIB) $(HCLG) @printf '[ OK ]\n' -# dummy_spral package - -dummy_spral_silent: $(DRLG)(dummy_spral_$(PRECIS).o) -dummy_spral: $(DRLG)(dummy_spral_$(PRECIS).o) - @printf ' %-21s\n' "GALAHAD: DUMMY compiled successfully" - -dummy_spral.o: $(DRLG)(dummy_spral_$(PRECIS).o) - -$(DRLG)(dummy_spral_$(PRECIS).o): ../dum/dummy_spral.F90 - @printf ' %-9s %-15s\t\t' "Compiling" "dummy_spral" - $(CP) ../dum/dummy_spral.F90 $(OBJ)/dummy_spral.F90 - cd $(OBJ); $(FORTRAN) -o dummy_spral_$(PRECIS).o \ - $(FFLAGSS) dummy_spral.F90 - cd $(OBJ); $(DRARR) dummy_spral_$(PRECIS).o ; \ - $(RM) dummy_spral.F90 dummy_spral_$(PRECIS).o - $(RANLIB) $(DRLG) - @printf '[ OK ]\n' - # blas_inter package blas_inter_silent: $(BLG)(blas_$(PRECIS).o) \ @@ -637,13 +619,6 @@ ulinearsolver_double_64: $($(ULINEARSOLVERD)) ulinearsolver_quadruple_64: $($(ULINEARSOLVERQ)) $(RANLIB) $(LGQ64) -SSIDSS = symbols_silent $(RLGS)(ssids_single.o) -SSIDSD = symbols_silent nodend_silent $(RLGD)(ssids_double.o) -SSIDSQ = symbols_silent $(RLGQ)(ssids_quadruple.o) -SSIDSS64 = symbols_silent $(RLGS64)(ssids_single_64.o) -SSIDSD64 = symbols_silent $(RLGD64)(ssids_double_64.o) -SSIDSQ64 = symbols_silent $(RLGQ64)(ssids_quadruple_64.o) - PARDISOS = symbols_silent $(PLGS)(pardiso.o) PARDISOD = symbols_silent $(PLGD)(pardiso.o) PARDISOQ = symbols_silent $(PLGQ)(pardiso.o) @@ -693,68 +668,14 @@ PASTIXS64 = symbols_silent $(PXLGS64)(spmf.o) $(PXLGS64)(pastixf.o) PASTIXD64 = symbols_silent $(PXLGD64)(spmf.o) $(PXLGD64)(pastixf.o) PASTIXQ64 = symbols_silent $(PXLGQ64)(spmf.o) $(PXLGQ64)(pastixf.o) -# ssids - -ssids_dum_silent: ssids_dum_silent_$(PRECIS) -ssids_dum_silent_single: $(SSIDSS) - $(RANLIB) $(RLGS) -ssids_dum_silent_double: $(SSIDSD) - $(RANLIB) $(RLGD) -ssids_dum_silent_quadruple: $(SSIDSQ) - $(RANLIB) $(RLGQ) -ssids_dum_silent_single_64: $(SSIDSS64) - $(RANLIB) $(RLGS64) -ssids_dum_silent_double_64: $(SSIDSD64) - $(RANLIB) $(RLGD64) -ssids_dum_silent_quadruple_64: $(SSIDSQ64) - $(RANLIB) $(RLGQ64) - -ssids_dum: ssids_dum_$(PRECIS) - @printf ' %-21s\n' "GALAHAD: $(SSIDS) ($(PRECIS) $(SUCC)" -ssids_dum_single: $(SSIDSS) - $(RANLIB) $(RLGS) -ssids_dum_double: $(SSIDSD) - $(RANLIB) $(RLGD) -ssids_dum_quadruple: $(SSIDSQ) - $(RANLIB) $(RLGQ) -ssids_dum_single_64: $(SSIDSS64) - $(RANLIB) $(RLGS64) -ssids_dum_double_64: $(SSIDSD64) - $(RANLIB) $(RLGD64) -ssids_dum_quadruple_64: $(SSIDSQ64) - $(RANLIB) $(RLGQ64) - -ssids_silent: - ( cd ../ssids ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ - ssids_silent PRECIS=$(PRECIS) PWD=$(PWD)/../ssids ) -ssids: - ( cd ../ssids ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ - ssids PRECIS=$(PRECIS) PWD=$(PWD)/../ssids ) - -ssids.o: $(RLG)(ssids_$(PRECIS).o) - -$(RLG)(ssids_$(PRECIS).o): ../dum/ssids.F90 - @printf ' %-9s %-15s\t\t' "Compiling" "ssidss_dum" - $(CP) ../dum/ssids.F90 $(OBJ)/ssids.F90 - cd $(OBJ); $(FORTRAN) -o ssids_$(PRECIS).o $(FFLAGS) ssids.F90 - cd $(OBJ); $(RARR) ssids_$(PRECIS).o ; $(RM) ssids.F90 ssids_$(PRECIS).o - $(MVMODS) - $(RMARFILE) sls_$(PRECIS).o - $(RANLIB) $(RLG) - @printf '[ OK ]\n' +# slblt -ssids_ciface.o: $(CLG)(ssids_ciface.o) - -$(CLG)(ssids_ciface.o): ../dum/C/ssids_ciface.F90 - @printf ' %-9s %-15s\t\t' "Compiling" "ssids_ciface" - $(CP) ../dum/C/ssids_ciface.F90 $(OBJ)/ssids_ciface.F90 - cd $(OBJ) ; $(FORTRAN) -o ssids_ciface_$(PRECIS).o $(FFLAGS) \ - ssids_ciface.F90 - cd $(OBJ) ; $(CARR) ssids_ciface_$(PRECIS).o ; \ - $(RM) ssids_ciface.F90 ssids_ciface_$(PRECIS).o - $(CRMARFILE) sls_ciface_$(PRECIS).o - $(MVMODS) - @printf '[ OK ]\n' +slblt_silent: + ( cd ../slblt ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ + slblt_silent PRECIS=$(PRECIS) PWD=$(PWD)/../slblt ) +slblt: + ( cd ../slblt ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ + slblt PRECIS=$(PRECIS) PWD=$(PWD)/../slblt ) # utility diff --git a/src/hw/LICENCE b/src/hw/LICENCE deleted file mode 100644 index 5c07a88395..0000000000 --- a/src/hw/LICENCE +++ /dev/null @@ -1,24 +0,0 @@ -Copyright (c) 2014-6, The Science and Technology Facilities Council (STFC) -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - * Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. - * Neither the name of the STFC nor the names of its contributors may be - used to endorse or promote products derived from this software without - specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL STFC BE LIABLE FOR ANY DIRECT, INDIRECT, -INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE -OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/src/hw/compat.cxx b/src/hw/compat.cxx deleted file mode 100644 index 55447f885d..0000000000 --- a/src/hw/compat.cxx +++ /dev/null @@ -1,24 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 09:00 GMT - * - * \brief - * Implements compatability functions depending on the value of autoconf macros. - * current version: 2025-08-27 - */ -#include "ssids_compat.hxx" -#include "ssids_config.h" - -#ifdef GALAHAD_HAVE_HWLOC -#define HAVE_HWLOC 1 -#else -#undef HAVE_HWLOC -#endif - -#ifdef GALAHAD_HAVE_SCHED_GETCPU -#define HAVE_SCHED_GETCPU 1 -#else -#undef HAVE_SCHED_GETCPU -#endif diff --git a/src/hw/guess_topology.cxx b/src/hw/guess_topology.cxx deleted file mode 100644 index ad52637dd2..0000000000 --- a/src/hw/guess_topology.cxx +++ /dev/null @@ -1,92 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * Nick Gould, fork from SPRAL for GALAHAD 5.3 - 2025-08-17 AT 09:00 GMT - * - * \brief - * Implements topology guessing functions. - * current version: 2025-08-27 - */ -#include "galahad_guess_topology.hxx" -#include "ssids_config.h" - -#ifdef _OPENMP -#include -#endif /* _OPENMP */ - -#ifdef HAVE_NVCC -#include -#endif /* HAVE_NVCC */ - -#include "ssids_compat.hxx" -#include "galahad_hwloc_wrapper.hxx" - -#include // debug - -using namespace galahad::hw_topology; - -/** - * \brief Guess hardware topology (using hwloc if available) - * \param nregions Number of regions. - * \param regions[nregions] Array of region descriptors, allocated by this - * routine. To free, call galahad_hw_topology_free(). - */ -extern "C" -void galahad_hw_topology_guess(int* nregions, NumaRegion** regions) { -#if HAVE_HWLOC - // Compiled with hwloc support - HwlocTopology topology; - auto numa_nodes = topology.get_numa_nodes(); - *nregions = numa_nodes.size(); - *regions = new NumaRegion[*nregions]; - for(int i=0; i<*nregions; ++i) { - NumaRegion& region = (*regions)[i]; -#if HWLOC_API_VERSION >= 0x20000 - auto parent = numa_nodes[i]->parent; - region.nproc = topology.count_cores(parent); - auto gpus = topology.get_gpus(parent); -#else /* HWLOC_API_VERSION */ - region.nproc = topology.count_cores(numa_nodes[i]); - auto gpus = topology.get_gpus(numa_nodes[i]); -#endif /* HWLOC_API_VERSION */ - region.ngpu = gpus.size(); - region.gpus = (region.ngpu > 0) ? new int[region.ngpu] : nullptr; - for(int i=0; i 0) ? new int[region.ngpu] : nullptr; - for(int i=0; i 0 ) THEN - CALL c_f_pointer( f_regions( i )%gpus, f_gpus, & - shape = (/ f_regions( i )%ngpu /) ) - regions( i )%gpus = f_gpus( : ) - END IF - END DO - END IF - -! free C version - - CALL galahad_hw_topology_free( nregions, c_regions ) - RETURN - - END SUBROUTINE HW_guess_topology - - END MODULE GALAHAD_HW diff --git a/src/hw/meson.build b/src/hw/meson.build deleted file mode 100644 index 374b3fc56c..0000000000 --- a/src/hw/meson.build +++ /dev/null @@ -1,3 +0,0 @@ -libgalahad_cpp_src += files('compat.cxx', 'guess_topology.cxx') - -libgalahad_src += files('hw.F90') diff --git a/src/lsrb/runlsrb b/src/lsrb/runlsrb index 3d9b4b0c93..6f28e0a2b5 100755 --- a/src/lsrb/runlsrb +++ b/src/lsrb/runlsrb @@ -254,19 +254,6 @@ HSL="" METIS4="" -# If there is a compiled, library version of the SPRAL sparse factorization -# package (http://ccpforge.cse.rl.ac.uk/gf/project/asearchralna/), set SPRAL -# to -lx, where the object library libx.so contains SPRAL. For instance if -# SPRAL is contained in the object library libspral.so, SPRAL should be -# set to "-lspral". If the library is in a "non-standard place", SPRAL -# should also point to the full path to the library. For example, if -# libspral.so is in the directory /mylibrary, SPRAL should be set to -# "-L/mylibrary -lspral" If a compiled version of SPRAL is unavailable, -# SPRAL should be set to "-lgalahad_spral". -# N.B. SPRAL is only optionally required but may improve performance. - -SPRAL="" - # If there is a compiled, library version of the PARDISO sparse factorization # package (http://www.pardiso-project.org/) , set PARDISO to -lx, # where the object library libx.so contains PARDISO. For instance if PARDISO @@ -390,7 +377,7 @@ fi GALOBJ=$GALAHAD/objects/$1/$PRECIS PROBLIB="" -# libraries for BLAS, LAPACK, HSL, METIS4, SPRAL, PARDISO, MKL_PARDISO, +# libraries for BLAS, LAPACK, HSL, METIS4, PARDISO, MKL_PARDISO, # WSMP and SUITESPARSE if [[ "$BLAS" == "" ]]; then @@ -417,12 +404,6 @@ else METISLIB="$METIS4" fi -if [[ "$SPRAL" == "" ]]; then - SPRALLIB="-lgalahad_spral" -else - SPRALLIB="$SPRAL" -fi - if [[ "$PARDISO" == "" ]]; then PARDISOLIB="-lgalahad_pardiso" else @@ -491,7 +472,7 @@ fi #EXECUTABLE="$FORTRAN $FFLAGS -o $galmin $RUNMAIN\ # -L$GALOBJ -lgalahad $PROBLIB -lgalahad\ -# $HSLLIB $SPRALLIB $PARDISOLIB $MKL_PARDISOLIB $WSMPLIB $SUITESPARSELIB\ +# $HSLLIB $PARDISOLIB $MKL_PARDISOLIB $WSMPLIB $SUITESPARSELIB\ # $METISLIB $LAPACKLIB $BLASLIB $PLPLOT" EXECUTABLE="$CUDACOMP $CUDAFLAGS -o $galmin $RUNMAIN\ diff --git a/src/makedefs/compile b/src/makedefs/compile index 15dc7b979c..fdfe33e8cb 100644 --- a/src/makedefs/compile +++ b/src/makedefs/compile @@ -85,7 +85,7 @@ $(PYLG)($(package)_pyiface.o): ../$(package)/Python/$(package)_pyiface.c -lgalahad -lgalahad_cutest_dummy $(HSL) $(MKL_PARDISO) \ $(PARDISO) $(WSMP) $(PASTIX) $(MUMPS) $(MPI) $(UMFPACK) \ $(METIS4ND) $(METIS5ND) $(LAPACK) $(BLAS) \ - -lgfortran -lstdc++ -lhwloc \ + -lgfortran \ -o $(PYSITEPACKDIR)/galahad/$(package).$(SOABI).$(DLEXT) \ -Wl,-rpath=$(OBJ)/shared $(MOMP) cd $(OBJ); $(RM) $(package)_pyiface.o diff --git a/src/makedefs/definitions b/src/makedefs/definitions index 6729aa6ff5..ef20b33029 100644 --- a/src/makedefs/definitions +++ b/src/makedefs/definitions @@ -328,13 +328,6 @@ PYLGS64 = $(OBJS64)/libgalahad_py.a PYLGD64 = $(OBJD64)/libgalahad_py.a PYLGQ64 = $(OBJQ64)/libgalahad_py.a -#DRLG = $(OBJ)/libgalahad_spral.a -#DRLGS = $(OBJS)/libgalahad_spral.a -#DRLGD = $(OBJD)/libgalahad_spral.a -#DRLGQ = $(OBJQ)/libgalahad_spral.a -#DRLGS64 = $(OBJS64)/libgalahad_spral.a -#DRLGD64 = $(OBJD64)/libgalahad_spral.a -#DRLGQ64 = $(OBJQ64)/libgalahad_spral.a DRLG = $(LG) DRLGS = $(LGS) diff --git a/src/makedefs/instructions b/src/makedefs/instructions index 5c6612d2ac..5dd8147e85 100644 --- a/src/makedefs/instructions +++ b/src/makedefs/instructions @@ -91,11 +91,11 @@ QRB$(PACKAGE)64 = $(RB_TESTS) $(TESTDEPS) $(OBJQ64)/run$(package)_rb_quadruple.o ifeq "$(HSL_64)" "_64" LIBS = -lgalahad $(HSL) $(MKL_PARDISO) $(PARDISO) $(WSMP) \ $(METIS4ND64) $(METIS5ND64) $(PASTIX) $(MUMPS) $(MPI) \ - $(UMFPACK) $(LAPACK) $(BLAS) -lstdc++ -lhwloc + $(UMFPACK) $(LAPACK) $(BLAS) else LIBS = -lgalahad $(HSL) $(MKL_PARDISO) $(PARDISO) $(WSMP) \ $(METIS4ND) $(METIS5ND) $(PASTIX) $(MUMPS) $(MPI) \ - $(UMFPACK) $(LAPACK) $(BLAS) -lstdc++ -lhwloc + $(UMFPACK) $(LAPACK) $(BLAS) endif PLIBS = $(LIBS) -lgalahad_problem CLIBS = -lgalahad_c -lhsl_c $(LIBS) @@ -2655,8 +2655,7 @@ $(package)ctm: $($(PACKAGE)CDTM) $($(PACKAGE)OBJECTSCS64) $(OBJS64)/libgalahad_mpi.a \ $(OBJS64)/libgalahad_umfpack.a \ $(OBJS64)/libgalahad_lapack.a \ - $(OBJS64)/libgalahad_blas.a \ - -lstdc++ -lhwloc + $(OBJS64)/libgalahad_blas.a $(RMOOC) - ./run_$(package) > $(package)dtm.output 2>&1 cat $(package)dtm.output diff --git a/src/makedefs/intermediaries b/src/makedefs/intermediaries index a480bb23ed..61e418348a 100644 --- a/src/makedefs/intermediaries +++ b/src/makedefs/intermediaries @@ -250,10 +250,10 @@ make_hash: $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) hash.o \ PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/hash ) -make_hw: - ( cd $(GALAHAD)/src/hw ; \ - $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) hw.o \ - PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/hw ) +make_topology: + ( cd $(GALAHAD)/src/topology ; \ + $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) topology.o \ + PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/topology ) make_ir: ( cd $(GALAHAD)/src/ir ; \ @@ -596,14 +596,13 @@ make_sls_deps: make_sls_deps_$(PRECIS) make_sls_deps_single: make_dummy make_specfile make_sort make_zd11 \ make_smt make_svt make_space make_sils make_nodend make_hsl \ - make_copyright make_spralrb make_amd make_$(SSIDS) -# make_spralrb make_amd make_ssids_dum + make_copyright make_spralrb make_amd make_slblt make_sls_deps_double: make_dummy make_specfile make_sort make_zd11 \ make_smt make_svt make_space make_sils make_nodend make_hsl \ - make_copyright make_spralrb make_amd make_$(SSIDS) + make_copyright make_spralrb make_amd make_slblt make_sls_deps_quadruple: make_dummy make_specfile make_sort make_zd11 \ make_smt make_svt make_space make_sils make_nodend make_hsl \ - make_copyright make_spralrb make_amd make_$(SSIDS) + make_copyright make_spralrb make_amd make_slblt make_sls_deps_single_64: make_sls_deps_single make_sls_deps_double_64: make_sls_deps_double make_sls_deps_quadruple_64: make_sls_deps_quadruple @@ -708,19 +707,14 @@ make_wcp: PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/wcp ) make_spralrb: - ( cd $(GALAHAD)/src/ssids ; \ + ( cd $(GALAHAD)/src/slblt ; \ $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) spralrb_silent \ - PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/ssids ) + PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/slblt ) -make_ssids: - ( cd $(GALAHAD)/src/ssids ; \ - $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) ssids_silent \ - PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/ssids ) - -make_ssids_dum: - ( cd $(GALAHAD)/src/dum ; \ - $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) ssids_dum_silent \ - PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/dum ) +make_slblt: + ( cd $(GALAHAD)/src/slblt ; \ + $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) slblt_silent \ + PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/slblt ) make_zd11: ( cd $(GALAHAD)/src/external/hsl ; \ @@ -1043,10 +1037,10 @@ make_all_hash: $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) hash_silent \ PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/hash ) -make_all_hw: - ( cd $(GALAHAD)/src/hw ; \ - $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) hw_silent \ - PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/hw ) +make_all_topology: + ( cd $(GALAHAD)/src/topology ; \ + $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) topology_silent \ + PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/topology ) make_all_ir: ( cd $(GALAHAD)/src/ir ; \ @@ -1423,19 +1417,14 @@ make_all_wcp: PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/wcp ) make_all_spralrb: - ( cd $(GALAHAD)/src/ssids ; \ + ( cd $(GALAHAD)/src/slblt ; \ $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) spralrb_silent \ - PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/ssids ) - -make_all_ssids: - ( cd $(GALAHAD)/src/ssids ; \ - $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) ssids_silent \ - PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/ssids ) + PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/slblt ) -make_all_ssids_dum: - ( cd $(GALAHAD)/src/dum ; \ - $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) ssids_dum_silent \ - PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/dum ) +make_all_slblt: + ( cd $(GALAHAD)/src/slblt ; \ + $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) slblt_silent \ + PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/slblt ) make_all_zd11: ( cd $(GALAHAD)/src/external/hsl ; \ @@ -1988,11 +1977,11 @@ make_ciface_sils: make_ciface_sls_deps: make_ciface_sls_deps_$(PRECIS) make_ciface_sls_deps_single: make_ciface_sils make_ciface_nodend \ - make_ciface_$(SSIDS) make_ciface_hsl + make_ciface_slblt make_ciface_hsl make_ciface_sls_deps_double: make_ciface_sils make_ciface_nodend \ - make_ciface_$(SSIDS) make_ciface_hsl + make_ciface_slblt make_ciface_hsl make_ciface_sls_deps_quadruple: make_ciface_sils make_ciface_nodend \ - make_ciface_$(SSIDS) make_ciface_hsl + make_ciface_slblt make_ciface_hsl make_ciface_sls_deps_single_64: make_ciface_sls_deps_single make_ciface_sls_deps_double_64: make_ciface_sls_deps_double make_ciface_sls_deps_quadruple_64: make_ciface_sls_deps_quadruple @@ -2110,15 +2099,10 @@ make_ciface_wcp: $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) wcp_ciface.o \ PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/wcp ) -make_ciface_ssids: - ( cd $(GALAHAD)/src/ssids ; \ - $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) ssids_ciface_silent \ - PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/ssids ) - -make_ciface_ssids_dum: - ( cd $(GALAHAD)/src/dum ; \ - $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) ssids_ciface.o \ - PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/dum ) +make_ciface_slblt: + ( cd $(GALAHAD)/src/slblt ; \ + $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) slblt_ciface_silent \ + PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/slblt ) # external packages @@ -2823,15 +2807,10 @@ make_pyiface_wcp: $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) wcp_pyiface.o \ PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/wcp ) -make_pyiface_ssids: - ( cd $(GALAHAD)/src/ssids ; \ - $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) ssids_pyiface_silent \ - PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/ssids ) - -make_pyiface_ssids_dum: - ( cd $(GALAHAD)/src/dum ; \ - $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) ssids_pyiface.o \ - PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/dum ) +make_pyiface_slblt: + ( cd $(GALAHAD)/src/slblt ; \ + $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) slblt_pyiface_silent \ + PRECIS=$(PRECIS) PWD=$(GALAHAD)/src/slblt ) # external packages diff --git a/src/matlab/galahad_sls.F90 b/src/matlab/galahad_sls.F90 index e671a2e660..a43de43e6f 100644 --- a/src/matlab/galahad_sls.F90 +++ b/src/matlab/galahad_sls.F90 @@ -1,7 +1,7 @@ #include -! THIS VERSION: GALAHAD 3.3 - 09/11/2020 AT 14:20 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 14:20 GMT. ! *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*- ! @@ -54,7 +54,7 @@ ! 'ma86' ! 'ma87' ! 'ma97' -! 'ssids' +! 'slblt' ! 'pardiso' ! 'wsmp' ! 'potr' diff --git a/src/matlab/galahad_sls.m b/src/matlab/galahad_sls.m index 29a40f177a..f2e887e7c9 100644 --- a/src/matlab/galahad_sls.m +++ b/src/matlab/galahad_sls.m @@ -45,7 +45,7 @@ % 'ma86' % 'ma87' % 'ma97' -% 'ssids' +% 'slblt' % 'pardiso' % 'wsmp' % 'potr' diff --git a/src/matlab/makemaster b/src/matlab/makemaster index a4f4f24f35..bab73d0a75 100644 --- a/src/matlab/makemaster +++ b/src/matlab/makemaster @@ -43,7 +43,7 @@ MLGD = $(OBJD)/libgalahad_matlab.a LIBS = -lgalahad_matlab -lgalahad $(HSL) $(MKL_PARDISO) $(PARDISO) \ $(WSMP) $(PASTIX) $(MUMPS) $(MPI) $(UMFPACK) \ - $(METIS4ND) $(METIS5ND) $(LAPACK) $(BLAS) -lhwloc + $(METIS4ND) $(METIS5ND) $(LAPACK) $(BLAS) # Archive manipulation strings @@ -289,13 +289,13 @@ basic_single: ( cd ../general ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ basic_silent PRECIS=$(PRECIS) PWD=$(PWD)/../general ) ( cd ../general ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ - ssids_dum PRECIS=$(PRECIS) PWD=$(PWD)/../general ) + slblt_silent PRECIS=$(PRECIS) PWD=$(PWD)/../general ) basic_double: $(MKDIR) -p $(MEXOUTDIR) ( cd ../general ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ basic_silent PRECIS=$(PRECIS) PWD=$(PWD)/../general ) ( cd ../general ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ - $(SSIDS)_silent PRECIS=$(PRECIS) PWD=$(PWD)/../general ) + slblt_silent PRECIS=$(PRECIS) PWD=$(PWD)/../general ) # arc diff --git a/src/matlab/test_galahad_sls.m b/src/matlab/test_galahad_sls.m index 5266d8ae8c..8674ea8e0a 100644 --- a/src/matlab/test_galahad_sls.m +++ b/src/matlab/test_galahad_sls.m @@ -14,7 +14,7 @@ A(1,1:n) = 1.0 ; %linear_solver = 'sytr'; -linear_solver = 'ssids'; +linear_solver = 'slblt'; %linear_solver = 'ma97'; [ control ] = galahad_sls( 'initial' ) ; diff --git a/src/mu/mu.F90 b/src/mu/mu.F90 index 284ebbba7b..0ab8955650 100644 --- a/src/mu/mu.F90 +++ b/src/mu/mu.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.3 - 2025-08-31 AT 10:00 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 10:00 GMT. #include "galahad_modules.h" @@ -21,12 +21,12 @@ MODULE GALAHAD_MU_precision PRIVATE PUBLIC :: MU_half_to_full, MU_convert_coord_to_cscl, MU_print_matrix, & MU_clean_cscl_oop, MU_apply_conversion_map, MU_cscl_verify, & - SSIDS_MATRIX_UNSPECIFIED, SSIDS_MATRIX_REAL_RECT, & - SSIDS_MATRIX_CPLX_RECT, SSIDS_MATRIX_REAL_UNSYM, & - SSIDS_MATRIX_CPLX_UNSYM, SSIDS_MATRIX_REAL_SYM_PSDEF, & - SSIDS_MATRIX_CPLX_HERM_PSDEF, SSIDS_MATRIX_REAL_SYM_INDEF, & - SSIDS_MATRIX_CPLX_HERM_INDEF, SSIDS_MATRIX_CPLX_SYM, & - SSIDS_MATRIX_REAL_SKEW, SSIDS_MATRIX_CPLX_SKEW + SLBLT_MATRIX_UNSPECIFIED, SLBLT_MATRIX_REAL_RECT, & + SLBLT_MATRIX_CPLX_RECT, SLBLT_MATRIX_REAL_UNSYM, & + SLBLT_MATRIX_CPLX_UNSYM, SLBLT_MATRIX_REAL_SYM_PSDEF, & + SLBLT_MATRIX_CPLX_HERM_PSDEF, SLBLT_MATRIX_REAL_SYM_INDEF, & + SLBLT_MATRIX_CPLX_HERM_INDEF, SLBLT_MATRIX_CPLX_SYM, & + SLBLT_MATRIX_REAL_SKEW, SLBLT_MATRIX_CPLX_SKEW !---------------------- ! P a r a m e t e r s @@ -40,53 +40,53 @@ MODULE GALAHAD_MU_precision ! undefined/known - INTEGER ( KIND = ip_ ), PARAMETER :: SSIDS_MATRIX_UNSPECIFIED = 0 + INTEGER ( KIND = ip_ ), PARAMETER :: SLBLT_MATRIX_UNSPECIFIED = 0 ! real rectangular - INTEGER ( KIND = ip_ ), PARAMETER :: SSIDS_MATRIX_REAL_RECT = 1 + INTEGER ( KIND = ip_ ), PARAMETER :: SLBLT_MATRIX_REAL_RECT = 1 ! real unsymmetric - INTEGER ( KIND = ip_ ), PARAMETER :: SSIDS_MATRIX_REAL_UNSYM = 2 + INTEGER ( KIND = ip_ ), PARAMETER :: SLBLT_MATRIX_REAL_UNSYM = 2 ! real sym positive definite - INTEGER ( KIND = ip_ ), PARAMETER :: SSIDS_MATRIX_REAL_SYM_PSDEF = 3 + INTEGER ( KIND = ip_ ), PARAMETER :: SLBLT_MATRIX_REAL_SYM_PSDEF = 3 ! real sym indefinite - INTEGER ( KIND = ip_ ), PARAMETER :: SSIDS_MATRIX_REAL_SYM_INDEF = 4 + INTEGER ( KIND = ip_ ), PARAMETER :: SLBLT_MATRIX_REAL_SYM_INDEF = 4 ! real skew symmetric - INTEGER ( KIND = ip_ ), PARAMETER :: SSIDS_MATRIX_REAL_SKEW = 6 + INTEGER ( KIND = ip_ ), PARAMETER :: SLBLT_MATRIX_REAL_SKEW = 6 ! matrix types : complex ! complex rectangular - INTEGER ( KIND = ip_ ), PARAMETER :: SSIDS_MATRIX_CPLX_RECT = - 1 + INTEGER ( KIND = ip_ ), PARAMETER :: SLBLT_MATRIX_CPLX_RECT = - 1 ! complex unsymmetric - INTEGER ( KIND = ip_ ), PARAMETER :: SSIDS_MATRIX_CPLX_UNSYM = - 2 + INTEGER ( KIND = ip_ ), PARAMETER :: SLBLT_MATRIX_CPLX_UNSYM = - 2 ! Hermitian positive definite - INTEGER ( KIND = ip_ ), PARAMETER :: SSIDS_MATRIX_CPLX_HERM_PSDEF = - 3 + INTEGER ( KIND = ip_ ), PARAMETER :: SLBLT_MATRIX_CPLX_HERM_PSDEF = - 3 ! Hermitian indefinite - INTEGER ( KIND = ip_ ), PARAMETER :: SSIDS_MATRIX_CPLX_HERM_INDEF = - 4 + INTEGER ( KIND = ip_ ), PARAMETER :: SLBLT_MATRIX_CPLX_HERM_INDEF = - 4 ! complex symmetric - INTEGER ( KIND = ip_ ), PARAMETER :: SSIDS_MATRIX_CPLX_SYM = - 5 + INTEGER ( KIND = ip_ ), PARAMETER :: SLBLT_MATRIX_CPLX_SYM = - 5 ! complex skew symmetric - INTEGER ( KIND = ip_ ), PARAMETER :: SSIDS_MATRIX_CPLX_SKEW = - 6 + INTEGER ( KIND = ip_ ), PARAMETER :: SLBLT_MATRIX_CPLX_SKEW = - 6 ! error flags @@ -284,7 +284,7 @@ SUBROUTINE cscl_verify_precision( lp, matrix_type, m, n, ptr, row, & CALL print_matrix_flag( context, lp, flag ) RETURN END IF - IF ( ABS( matrix_type ) /= SSIDS_MATRIX_REAL_RECT .AND. m /= n ) THEN + IF ( ABS( matrix_type ) /= SLBLT_MATRIX_REAL_RECT .AND. m /= n ) THEN flag = ERROR_M_NE_N CALL print_matrix_flag( context, lp, flag ) RETURN @@ -325,9 +325,9 @@ SUBROUTINE cscl_verify_precision( lp, matrix_type, m, n, ptr, row, & IF ( st /= 0 ) GO TO 100 ptr2( : ) = 0 - lwronly = ABS( matrix_type ) /= SSIDS_MATRIX_UNSPECIFIED .AND. & - ABS( matrix_type ) /= SSIDS_MATRIX_REAL_RECT .AND. & - ABS( matrix_type ) /= SSIDS_MATRIX_REAL_UNSYM + lwronly = ABS( matrix_type ) /= SLBLT_MATRIX_UNSPECIFIED .AND. & + ABS( matrix_type ) /= SLBLT_MATRIX_REAL_RECT .AND. & + ABS( matrix_type ) /= SLBLT_MATRIX_REAL_UNSYM DO col = 1, n last = - 1 diag = .FALSE. @@ -345,7 +345,7 @@ SUBROUTINE cscl_verify_precision( lp, matrix_type, m, n, ptr, row, & CALL print_matrix_flag( context, lp, flag ) RETURN END IF - IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SKEW .AND. & + IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SKEW .AND. & k == col ) THEN flag = ERROR_UPR_ENTRY more = j @@ -382,7 +382,7 @@ SUBROUTINE cscl_verify_precision( lp, matrix_type, m, n, ptr, row, & ! If marked as positive definite, check if diagonal was present - IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_PSDEF .AND. & + IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_PSDEF .AND. & .NOT. diag ) THEN flag = ERROR_MISSING_DIAGONAL more = col @@ -393,7 +393,7 @@ SUBROUTINE cscl_verify_precision( lp, matrix_type, m, n, ptr, row, & IF ( PRESENT( val ) ) THEN SELECT CASE ( matrix_type ) - CASE ( SSIDS_MATRIX_REAL_SYM_PSDEF ) + CASE ( SLBLT_MATRIX_REAL_SYM_PSDEF ) ! check for positive diagonal entries @@ -525,22 +525,22 @@ SUBROUTINE print_matrix_int_precision( lp, lines, matrix_type, m, n, & nefrmt = digit_format( ptr( n + 1 ) - 1_ip_ ) SELECT CASE ( matrix_type ) - CASE ( SSIDS_MATRIX_UNSPECIFIED ) + CASE ( SLBLT_MATRIX_UNSPECIFIED ) WRITE ( lp, '( A )', ADVANCE = 'no' ) & 'Matrix of undefined type, dimension ' - CASE ( SSIDS_MATRIX_REAL_RECT ) + CASE ( SLBLT_MATRIX_REAL_RECT ) WRITE ( lp, '( A )', ADVANCE = 'no' ) & 'Real rectangular matrix, dimension ' - CASE ( SSIDS_MATRIX_REAL_UNSYM ) + CASE ( SLBLT_MATRIX_REAL_UNSYM ) WRITE ( lp, '( A )', ADVANCE = 'no' ) & 'Real unsymmetric matrix, dimension ' - CASE ( SSIDS_MATRIX_REAL_SYM_PSDEF ) + CASE ( SLBLT_MATRIX_REAL_SYM_PSDEF ) WRITE ( lp, '( A )', ADVANCE = 'no' ) & 'Real symmetric positive definite matrix, dimension ' - CASE ( SSIDS_MATRIX_REAL_SYM_INDEF ) + CASE ( SLBLT_MATRIX_REAL_SYM_INDEF ) WRITE ( lp, '( A )', ADVANCE = 'no' ) & 'Real symmetric indefinite matrix, dimension ' - CASE ( SSIDS_MATRIX_REAL_SKEW ) + CASE ( SLBLT_MATRIX_REAL_SKEW ) WRITE ( lp, '( A )', ADVANCE = 'no' ) & 'Real skew symmetric matrix, dimension ' CASE DEFAULT @@ -569,7 +569,7 @@ SUBROUTINE print_matrix_int_precision( lp, lines, matrix_type, m, n, & DO col = 1, n DO j = ptr( col ) + rebase, ptr( col + 1 ) + rebase - 1 k = row( j ) + rebase - IF ( ABS( matrix_type ) >= SSIDS_MATRIX_REAL_SYM_PSDEF ) THEN + IF ( ABS( matrix_type ) >= SLBLT_MATRIX_REAL_SYM_PSDEF ) THEN dmat( col, k ) = -j END IF dmat( k, col ) = j @@ -607,8 +607,8 @@ SUBROUTINE print_matrix_int_precision( lp, lines, matrix_type, m, n, & END IF ELSE ! in upper triangle SELECT CASE ( matrix_type ) - CASE ( SSIDS_MATRIX_REAL_SYM_INDEF, & - SSIDS_MATRIX_REAL_SYM_PSDEF ) + CASE ( SLBLT_MATRIX_REAL_SYM_INDEF, & + SLBLT_MATRIX_REAL_SYM_PSDEF ) IF ( val( - dmat( k,j ) ) > zero ) THEN WRITE ( lp, valfrmt, ADVANCE = 'no' ) & val( - dmat( k, j ) ) @@ -616,7 +616,7 @@ SUBROUTINE print_matrix_int_precision( lp, lines, matrix_type, m, n, & WRITE ( lp, negfrmt, ADVANCE = 'no' ) & val( - dmat( k, j ) ) END IF - CASE ( SSIDS_MATRIX_REAL_SKEW ) + CASE ( SLBLT_MATRIX_REAL_SKEW ) IF ( - val( - dmat( k,j ) ) > zero ) THEN WRITE ( lp, valfrmt, ADVANCE = 'no' ) & - val( - dmat( k, j ) ) @@ -1011,9 +1011,9 @@ SUBROUTINE clean_cscl_oop_main_ptr32( context, multiplier, & RETURN END IF minidx = 1 - IF ( ABS( matrix_type ) >= SSIDS_MATRIX_REAL_SYM_PSDEF ) & + IF ( ABS( matrix_type ) >= SLBLT_MATRIX_REAL_SYM_PSDEF ) & minidx = col - IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SKEW ) & + IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SKEW ) & minidx = col + 1 ! loop over column, copy across while dropping any out of range entries @@ -1051,7 +1051,7 @@ SUBROUTINE clean_cscl_oop_main_ptr32( context, multiplier, & IF ( row_out( ptr_out( col ) ) == col ) THEN idiag = idiag + 1 - ELSE IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_PSDEF ) THEN + ELSE IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_PSDEF ) THEN flag = ERROR_MISSING_DIAGONAL CALL print_matrix_flag( context, nout, flag ) CALL cleanup_dup( duphead ) @@ -1073,7 +1073,7 @@ SUBROUTINE clean_cscl_oop_main_ptr32( context, multiplier, & map( k ) = map( i ) k = k + 1 END DO - ELSE IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_PSDEF ) THEN + ELSE IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_PSDEF ) THEN flag = ERROR_MISSING_DIAGONAL CALL print_matrix_flag( context, nout, flag ) CALL cleanup_dup( duphead ) @@ -1094,15 +1094,15 @@ SUBROUTINE clean_cscl_oop_main_ptr32( context, multiplier, & RETURN END IF minidx = 1 - IF ( ABS( matrix_type ) >= SSIDS_MATRIX_REAL_SYM_PSDEF ) & + IF ( ABS( matrix_type ) >= SLBLT_MATRIX_REAL_SYM_PSDEF ) & minidx = col - IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SKEW ) & + IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SKEW ) & minidx = col + 1 ! Loop over column, copy across while dropping any out of range entries SELECT CASE ( matrix_type ) - CASE ( SSIDS_MATRIX_REAL_SKEW ) + CASE ( SLBLT_MATRIX_REAL_SKEW ) DO i = ptr_in( col ), ptr_in( col + 1 ) - 1 j = row_in( i ) IF ( j < minidx .OR. j > m ) THEN ! out of range, ignore @@ -1147,7 +1147,7 @@ SUBROUTINE clean_cscl_oop_main_ptr32( context, multiplier, & IF ( row_out( ptr_out( col ) ) == col ) THEN idiag = idiag + 1 - ELSE IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_PSDEF ) THEN + ELSE IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_PSDEF ) THEN flag = ERROR_MISSING_DIAGONAL CALL print_matrix_flag( context, nout, flag ) RETURN @@ -1164,7 +1164,7 @@ SUBROUTINE clean_cscl_oop_main_ptr32( context, multiplier, & val_out( k ) = val_out( i ) k = k + 1 END DO - ELSE IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_PSDEF ) THEN + ELSE IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_PSDEF ) THEN flag = ERROR_MISSING_DIAGONAL CALL print_matrix_flag( context, nout, flag ) RETURN @@ -1181,9 +1181,9 @@ SUBROUTINE clean_cscl_oop_main_ptr32( context, multiplier, & RETURN END IF minidx = 1 - IF ( ABS( matrix_type ) >= SSIDS_MATRIX_REAL_SYM_PSDEF ) & + IF ( ABS( matrix_type ) >= SLBLT_MATRIX_REAL_SYM_PSDEF ) & minidx = col - IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SKEW ) & + IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SKEW ) & minidx = col + 1 ! loop over column, copy across while dropping any out of range entries @@ -1218,7 +1218,7 @@ SUBROUTINE clean_cscl_oop_main_ptr32( context, multiplier, & IF ( row_out( ptr_out( col ) ) == col ) THEN idiag = idiag + 1 - ELSE IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_PSDEF ) THEN + ELSE IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_PSDEF ) THEN flag = ERROR_MISSING_DIAGONAL CALL print_matrix_flag( context, nout, flag ) RETURN @@ -1232,7 +1232,7 @@ SUBROUTINE clean_cscl_oop_main_ptr32( context, multiplier, & row_out( k ) = row_out( i ) k = k + 1 END DO - ELSE IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_PSDEF ) THEN + ELSE IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_PSDEF ) THEN flag = ERROR_MISSING_DIAGONAL CALL print_matrix_flag( context, nout, flag ) RETURN @@ -1263,7 +1263,7 @@ SUBROUTINE clean_cscl_oop_main_ptr32( context, multiplier, & IF ( PRESENT( val_out ) ) THEN SELECT CASE ( matrix_type ) - CASE ( SSIDS_MATRIX_REAL_SYM_PSDEF ) + CASE ( SLBLT_MATRIX_REAL_SYM_PSDEF ) ! check for positive diagonal entries @@ -1287,7 +1287,7 @@ SUBROUTINE clean_cscl_oop_main_ptr32( context, multiplier, & IF ( ioor > 0 ) flag = WARNING_IDX_OOR IF ( idup > 0 ) flag = WARNING_DUP_IDX IF ( idup > 0 .AND. ioor > 0 ) flag = WARNING_DUP_AND_OOR - IF ( ABS( matrix_type ) /= SSIDS_MATRIX_REAL_SKEW ) THEN + IF ( ABS( matrix_type ) /= SLBLT_MATRIX_REAL_SKEW ) THEN IF ( idiag < n .AND. ioor > 0 ) THEN flag = WARNING_MISS_DIAG_OORDUP ELSE IF ( idiag < n .AND. idup > 0 ) THEN @@ -1457,9 +1457,9 @@ SUBROUTINE clean_cscl_oop_main( context, multiplier, matrix_type, & RETURN END IF minidx = 1 - IF ( ABS( matrix_type ) >= SSIDS_MATRIX_REAL_SYM_PSDEF ) & + IF ( ABS( matrix_type ) >= SLBLT_MATRIX_REAL_SYM_PSDEF ) & minidx = col - IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SKEW ) & + IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SKEW ) & minidx = col + 1 ! loop over column, copy across while dropping any out of range entries @@ -1497,7 +1497,7 @@ SUBROUTINE clean_cscl_oop_main( context, multiplier, matrix_type, & IF ( row_out( ptr_out( col ) ) == col ) THEN idiag = idiag + 1 - ELSE IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_PSDEF ) THEN + ELSE IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_PSDEF ) THEN flag = ERROR_MISSING_DIAGONAL CALL print_matrix_flag( context, nout, flag ) CALL cleanup_dup( duphead ) @@ -1519,7 +1519,7 @@ SUBROUTINE clean_cscl_oop_main( context, multiplier, matrix_type, & map( kk ) = map( ii ) kk = kk + 1 END DO - ELSE IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_PSDEF ) THEN + ELSE IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_PSDEF ) THEN flag = ERROR_MISSING_DIAGONAL CALL print_matrix_flag( context, nout, flag ) CALL cleanup_dup( duphead ) @@ -1540,15 +1540,15 @@ SUBROUTINE clean_cscl_oop_main( context, multiplier, matrix_type, & RETURN END IF minidx = 1 - IF ( ABS( matrix_type ) >= SSIDS_MATRIX_REAL_SYM_PSDEF ) & + IF ( ABS( matrix_type ) >= SLBLT_MATRIX_REAL_SYM_PSDEF ) & minidx = col - IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SKEW ) & + IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SKEW ) & minidx = col + 1 ! loop over column, copy across while dropping any out of range entries SELECT CASE ( matrix_type ) - CASE ( SSIDS_MATRIX_REAL_SKEW ) + CASE ( SLBLT_MATRIX_REAL_SKEW ) DO ii = ptr_in( col ), ptr_in( col + 1 ) - 1 j = row_in( ii ) IF ( j < minidx .OR. j > m ) THEN ! out of range, ignore @@ -1592,7 +1592,7 @@ SUBROUTINE clean_cscl_oop_main( context, multiplier, matrix_type, & IF ( row_out( ptr_out( col ) ) == col ) THEN idiag = idiag + 1 - ELSE IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_PSDEF ) THEN + ELSE IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_PSDEF ) THEN flag = ERROR_MISSING_DIAGONAL CALL print_matrix_flag( context, nout, flag ) RETURN @@ -1611,7 +1611,7 @@ SUBROUTINE clean_cscl_oop_main( context, multiplier, matrix_type, & val_out( kk ) = val_out( ii ) kk = kk + 1 END DO - ELSE IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_PSDEF ) THEN + ELSE IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_PSDEF ) THEN flag = ERROR_MISSING_DIAGONAL CALL print_matrix_flag( context, nout, flag ) RETURN @@ -1628,9 +1628,9 @@ SUBROUTINE clean_cscl_oop_main( context, multiplier, matrix_type, & RETURN END IF minidx = 1 - IF ( ABS( matrix_type ) >= SSIDS_MATRIX_REAL_SYM_PSDEF ) & + IF ( ABS( matrix_type ) >= SLBLT_MATRIX_REAL_SYM_PSDEF ) & minidx = col - IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SKEW ) & + IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SKEW ) & minidx = col + 1 ! loop over column, copy across while dropping any out of range entries @@ -1665,7 +1665,7 @@ SUBROUTINE clean_cscl_oop_main( context, multiplier, matrix_type, & IF ( row_out( ptr_out( col ) ) == col ) THEN idiag = idiag + 1 - ELSE IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_PSDEF ) THEN + ELSE IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_PSDEF ) THEN flag = ERROR_MISSING_DIAGONAL CALL print_matrix_flag( context, nout, flag ) RETURN @@ -1679,7 +1679,7 @@ SUBROUTINE clean_cscl_oop_main( context, multiplier, matrix_type, & row_out( kk ) = row_out( ii ) kk = kk + 1 END DO - ELSE IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_PSDEF ) THEN + ELSE IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_PSDEF ) THEN flag = ERROR_MISSING_DIAGONAL CALL print_matrix_flag( context, nout, flag ) RETURN @@ -1710,7 +1710,7 @@ SUBROUTINE clean_cscl_oop_main( context, multiplier, matrix_type, & IF ( PRESENT( val_out ) ) THEN SELECT CASE ( matrix_type ) - CASE ( SSIDS_MATRIX_REAL_SYM_PSDEF ) + CASE ( SLBLT_MATRIX_REAL_SYM_PSDEF ) ! check for positive diagonal entries @@ -1734,7 +1734,7 @@ SUBROUTINE clean_cscl_oop_main( context, multiplier, matrix_type, & IF ( ioor > 0 ) flag = WARNING_IDX_OOR IF ( idup > 0 ) flag = WARNING_DUP_IDX IF ( idup > 0 .AND. ioor > 0 ) flag = WARNING_DUP_AND_OOR - IF ( ABS( matrix_type ) /= SSIDS_MATRIX_REAL_SKEW ) THEN + IF ( ABS( matrix_type ) /= SLBLT_MATRIX_REAL_SKEW ) THEN IF ( idiag < n .AND. ioor > 0 ) THEN flag = WARNING_MISS_DIAG_OORDUP ELSE IF ( idiag < n .AND. idup > 0 ) THEN @@ -1865,7 +1865,7 @@ SUBROUTINE convert_coord_to_cscl_ptr32_precision( matrix_type, m, n, & RETURN END IF - IF ( ABS( matrix_type ) >= SSIDS_MATRIX_REAL_UNSYM .AND. m /= n ) THEN + IF ( ABS( matrix_type ) >= SLBLT_MATRIX_REAL_UNSYM .AND. m /= n ) THEN flag = ERROR_M_NE_N CALL print_matrix_flag( context, nout, flag ) RETURN @@ -1910,13 +1910,13 @@ SUBROUTINE convert_coord_to_cscl_ptr32_precision( matrix_type, m, n, & CYCLE END IF - IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SKEW .AND. i == j ) THEN + IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SKEW .AND. i == j ) THEN ioor = ioor + 1 CYCLE END IF SELECT CASE ( ABS( matrix_type ) ) - CASE ( SSIDS_MATRIX_REAL_SYM_PSDEF: ) + CASE ( SLBLT_MATRIX_REAL_SYM_PSDEF: ) IF ( i >= j ) THEN ptr_out( j + 1 ) = ptr_out( j + 1 ) + 1 ELSE @@ -1956,7 +1956,7 @@ SUBROUTINE convert_coord_to_cscl_ptr32_precision( matrix_type, m, n, & IF ( st /= 0 ) GO TO 100 map( : ) = 0 SELECT CASE ( matrix_type ) - CASE ( SSIDS_MATRIX_REAL_SKEW ) + CASE ( SLBLT_MATRIX_REAL_SKEW ) DO l = 1, ne i = row( l ) j = col( l ) @@ -1974,7 +1974,7 @@ SUBROUTINE convert_coord_to_cscl_ptr32_precision( matrix_type, m, n, & END IF END DO - CASE ( SSIDS_MATRIX_REAL_SYM_PSDEF, SSIDS_MATRIX_REAL_SYM_INDEF ) + CASE ( SLBLT_MATRIX_REAL_SYM_PSDEF, SLBLT_MATRIX_REAL_SYM_INDEF ) DO l = 1, ne i = row( l ) j = col( l ) @@ -2006,7 +2006,7 @@ SUBROUTINE convert_coord_to_cscl_ptr32_precision( matrix_type, m, n, & ALLOCATE ( val_out( ne_new ), STAT = st ) IF ( st /= 0 ) GO TO 100 SELECT CASE ( matrix_type ) - CASE ( SSIDS_MATRIX_REAL_SKEW ) + CASE ( SLBLT_MATRIX_REAL_SKEW ) DO l = 1, ne i = row( l ) j = col( l ) @@ -2024,7 +2024,7 @@ SUBROUTINE convert_coord_to_cscl_ptr32_precision( matrix_type, m, n, & END IF END DO - CASE ( SSIDS_MATRIX_REAL_SYM_PSDEF, SSIDS_MATRIX_REAL_SYM_INDEF ) + CASE ( SLBLT_MATRIX_REAL_SYM_PSDEF, SLBLT_MATRIX_REAL_SYM_INDEF ) DO l = 1, ne i = row( l ) j = col( l ) @@ -2057,7 +2057,7 @@ SUBROUTINE convert_coord_to_cscl_ptr32_precision( matrix_type, m, n, & ELSE SELECT CASE ( matrix_type ) - CASE ( SSIDS_MATRIX_REAL_SKEW ) + CASE ( SLBLT_MATRIX_REAL_SKEW ) DO l = 1, ne i = row( l ) j = col( l ) @@ -2073,7 +2073,7 @@ SUBROUTINE convert_coord_to_cscl_ptr32_precision( matrix_type, m, n, & END IF END DO - CASE ( SSIDS_MATRIX_REAL_SYM_PSDEF, SSIDS_MATRIX_REAL_SYM_INDEF ) + CASE ( SLBLT_MATRIX_REAL_SYM_PSDEF, SLBLT_MATRIX_REAL_SYM_INDEF ) DO l = 1, ne i = row( l ) j = col( l ) @@ -2262,7 +2262,7 @@ SUBROUTINE convert_coord_to_cscl_ptr32_precision( matrix_type, m, n, & ! check for missing diagonals in pos def and indef cases ! Note: change this test for complex case - IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_PSDEF ) THEN + IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_PSDEF ) THEN DO j = 1, n IF ( ptr_out( j ) < ptr_out( n + 1 ) ) THEN IF ( row_out( ptr_out( j ) ) /= j ) THEN @@ -2295,7 +2295,7 @@ SUBROUTINE convert_coord_to_cscl_ptr32_precision( matrix_type, m, n, & IF ( PRESENT( val_out ) ) THEN SELECT CASE ( matrix_type ) - CASE ( SSIDS_MATRIX_REAL_SYM_PSDEF ) + CASE ( SLBLT_MATRIX_REAL_SYM_PSDEF ) ! check for positive diagonal entries @@ -2319,7 +2319,7 @@ SUBROUTINE convert_coord_to_cscl_ptr32_precision( matrix_type, m, n, & IF ( ioor > 0 ) flag = WARNING_IDX_OOR IF ( idup > 0 ) flag = WARNING_DUP_IDX IF ( idup > 0 .AND. ioor > 0 ) flag = WARNING_DUP_AND_OOR - IF ( ABS( matrix_type ) /= SSIDS_MATRIX_REAL_SKEW ) THEN + IF ( ABS( matrix_type ) /= SLBLT_MATRIX_REAL_SKEW ) THEN IF ( idiag < n .AND. ioor > 0 ) THEN flag = WARNING_MISS_DIAG_OORDUP ELSE IF ( idiag < n .AND. idup > 0 ) THEN @@ -2337,13 +2337,13 @@ SUBROUTINE convert_coord_to_cscl_ptr32_precision( matrix_type, m, n, & IF ( ioor > 0 ) flag = WARNING_IDX_OOR IF ( idup > 0 ) flag = WARNING_DUP_IDX IF ( idup > 0 .AND. ioor > 0 ) flag = WARNING_DUP_AND_OOR - IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_INDEF .AND. & + IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_INDEF .AND. & idiag < n .AND. ioor > 0 ) THEN flag = WARNING_MISS_DIAG_OORDUP - ELSE IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_INDEF .AND. & + ELSE IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_INDEF .AND. & idiag < n .AND. idup > 0 ) THEN flag = WARNING_MISS_DIAG_OORDUP - ELSE IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_INDEF .AND. & + ELSE IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_INDEF .AND. & idiag < n ) THEN flag = WARNING_MISSING_DIAGONAL END IF @@ -2476,7 +2476,7 @@ SUBROUTINE convert_coord_to_cscl_ptr64_precision( matrix_type, m, n, & RETURN END IF - IF ( ABS( matrix_type ) >= SSIDS_MATRIX_REAL_UNSYM .AND. m /= n ) THEN + IF ( ABS( matrix_type ) >= SLBLT_MATRIX_REAL_UNSYM .AND. m /= n ) THEN flag = ERROR_M_NE_N CALL print_matrix_flag( context, nout, flag ) RETURN @@ -2521,13 +2521,13 @@ SUBROUTINE convert_coord_to_cscl_ptr64_precision( matrix_type, m, n, & CYCLE END IF - IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SKEW .AND. i == j ) THEN + IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SKEW .AND. i == j ) THEN ioor = ioor + 1 CYCLE END IF SELECT CASE ( ABS( matrix_type ) ) - CASE ( SSIDS_MATRIX_REAL_SYM_PSDEF: ) + CASE ( SLBLT_MATRIX_REAL_SYM_PSDEF: ) IF ( i >= j ) THEN ptr_out( j + 1 ) = ptr_out( j + 1 ) + 1 ELSE @@ -2567,7 +2567,7 @@ SUBROUTINE convert_coord_to_cscl_ptr64_precision( matrix_type, m, n, & IF ( st /= 0 ) GO TO 100 map( : ) = 0 SELECT CASE ( matrix_type ) - CASE ( SSIDS_MATRIX_REAL_SKEW ) + CASE ( SLBLT_MATRIX_REAL_SKEW ) DO ll = 1, ne i = row( ll ) j = col( ll ) @@ -2585,7 +2585,7 @@ SUBROUTINE convert_coord_to_cscl_ptr64_precision( matrix_type, m, n, & END IF END DO - CASE ( SSIDS_MATRIX_REAL_SYM_PSDEF, SSIDS_MATRIX_REAL_SYM_INDEF ) + CASE ( SLBLT_MATRIX_REAL_SYM_PSDEF, SLBLT_MATRIX_REAL_SYM_INDEF ) DO ll = 1, ne i = row( ll ) j = col( ll ) @@ -2617,7 +2617,7 @@ SUBROUTINE convert_coord_to_cscl_ptr64_precision( matrix_type, m, n, & ALLOCATE ( val_out( ne_new ), STAT = st ) IF ( st /= 0 ) GO TO 100 SELECT CASE ( matrix_type ) - CASE ( SSIDS_MATRIX_REAL_SKEW ) + CASE ( SLBLT_MATRIX_REAL_SKEW ) DO ll = 1, ne i = row( ll ) j = col( ll ) @@ -2635,7 +2635,7 @@ SUBROUTINE convert_coord_to_cscl_ptr64_precision( matrix_type, m, n, & END IF END DO - CASE ( SSIDS_MATRIX_REAL_SYM_PSDEF, SSIDS_MATRIX_REAL_SYM_INDEF ) + CASE ( SLBLT_MATRIX_REAL_SYM_PSDEF, SLBLT_MATRIX_REAL_SYM_INDEF ) DO ll = 1, ne i = row( ll ) j = col( ll ) @@ -2668,7 +2668,7 @@ SUBROUTINE convert_coord_to_cscl_ptr64_precision( matrix_type, m, n, & ELSE SELECT CASE ( matrix_type ) - CASE ( SSIDS_MATRIX_REAL_SKEW ) + CASE ( SLBLT_MATRIX_REAL_SKEW ) DO ll = 1, ne i = row( ll ) j = col( ll ) @@ -2684,7 +2684,7 @@ SUBROUTINE convert_coord_to_cscl_ptr64_precision( matrix_type, m, n, & END IF END DO - CASE ( SSIDS_MATRIX_REAL_SYM_PSDEF, SSIDS_MATRIX_REAL_SYM_INDEF ) + CASE ( SLBLT_MATRIX_REAL_SYM_PSDEF, SLBLT_MATRIX_REAL_SYM_INDEF ) DO ll = 1, ne i = row( ll ) j = col( ll ) @@ -2871,7 +2871,7 @@ SUBROUTINE convert_coord_to_cscl_ptr64_precision( matrix_type, m, n, & ! check for missing diagonals in pos def and indef cases ! Note: change this test for complex case - IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_PSDEF ) THEN + IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_PSDEF ) THEN DO j = 1, n IF ( ptr_out( j ) < ptr_out( n + 1 ) ) THEN IF ( row_out( ptr_out( j ) ) /= j ) THEN @@ -2904,7 +2904,7 @@ SUBROUTINE convert_coord_to_cscl_ptr64_precision( matrix_type, m, n, & IF ( PRESENT( val_out ) ) THEN SELECT CASE ( matrix_type ) - CASE ( SSIDS_MATRIX_REAL_SYM_PSDEF ) + CASE ( SLBLT_MATRIX_REAL_SYM_PSDEF ) ! check for positive diagonal entries @@ -2928,7 +2928,7 @@ SUBROUTINE convert_coord_to_cscl_ptr64_precision( matrix_type, m, n, & IF ( ioor > 0 ) flag = WARNING_IDX_OOR IF ( idup > 0 ) flag = WARNING_DUP_IDX IF ( idup > 0 .AND. ioor > 0 ) flag = WARNING_DUP_AND_OOR - IF ( ABS( matrix_type ) /= SSIDS_MATRIX_REAL_SKEW ) THEN + IF ( ABS( matrix_type ) /= SLBLT_MATRIX_REAL_SKEW ) THEN IF ( idiag < n .AND. ioor > 0 ) THEN flag = WARNING_MISS_DIAG_OORDUP ELSE IF ( idiag < n .AND. idup > 0 ) THEN @@ -2946,13 +2946,13 @@ SUBROUTINE convert_coord_to_cscl_ptr64_precision( matrix_type, m, n, & IF ( ioor > 0 ) flag = WARNING_IDX_OOR IF ( idup > 0 ) flag = WARNING_DUP_IDX IF ( idup > 0 .AND. ioor > 0 ) flag = WARNING_DUP_AND_OOR - IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_INDEF .AND. & + IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_INDEF .AND. & idiag < n .AND. ioor > 0 ) THEN flag = WARNING_MISS_DIAG_OORDUP - ELSE IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_INDEF .AND. & + ELSE IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_INDEF .AND. & idiag < n .AND. idup > 0 ) THEN flag = WARNING_MISS_DIAG_OORDUP - ELSE IF ( ABS( matrix_type ) == SSIDS_MATRIX_REAL_SYM_INDEF .AND. & + ELSE IF ( ABS( matrix_type ) == SLBLT_MATRIX_REAL_SYM_INDEF .AND. & idiag < n ) THEN flag = WARNING_MISSING_DIAGONAL END IF @@ -3011,7 +3011,7 @@ SUBROUTINE apply_conversion_map_ptr32_precision( matrix_type, lmap, & ! skew symmetric matrix - CASE ( SSIDS_MATRIX_REAL_SKEW ) + CASE ( SLBLT_MATRIX_REAL_SKEW ) ! first set val_out using first part of map @@ -3072,7 +3072,7 @@ SUBROUTINE apply_conversion_map_ptr64_precision( matrix_type, lmap, & ! skew symmetric matrix - CASE ( SSIDS_MATRIX_REAL_SKEW ) + CASE ( SLBLT_MATRIX_REAL_SKEW ) ! first set val_out using first part of map diff --git a/src/nodend/RUNNODEND.meta b/src/nodend/RUNNODEND.meta index 5bc46bcdcb..da762c841a 100644 --- a/src/nodend/RUNNODEND.meta +++ b/src/nodend/RUNNODEND.meta @@ -7,7 +7,7 @@ MAIN ! result-summary-file-name NODENDRES.d ! result-summary-file-device 47 ! analyse no -! symmetric-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt ! exhaustive-tests no ! all-versions no INCLUDE NODEND diff --git a/src/nodend/usenodend.F90 b/src/nodend/usenodend.F90 index 35a2e81ff8..d2c4f1c092 100644 --- a/src/nodend/usenodend.F90 +++ b/src/nodend/usenodend.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.4 - 2025-08-31 AT 13:35 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 13:35 GMT. #include "galahad_modules.h" #include "cutest_routines.h" @@ -110,7 +110,7 @@ SUBROUTINE USE_NODEND( input ) ! result-summary-file-name NODENDRES.d ! result-summary-file-device 47 ! analyse NO -! symmetric-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt ! exhaustive-tests NO ! all-versions NO ! END RUNNODEND SPECIFICATIONS @@ -127,7 +127,7 @@ SUBROUTINE USE_NODEND( input ) LOGICAL :: all_versions = .FALSE. CHARACTER ( LEN = 30 ) :: pfilename = 'NODENDPERM.d' CHARACTER ( LEN = 30 ) :: rfilename = 'NODENDRES.d' - CHARACTER ( LEN = 30 ) :: solver = "ssids" // REPEAT( ' ', 25 ) + CHARACTER ( LEN = 30 ) :: solver = "slblt" // REPEAT( ' ', 25 ) ! Output file characteristics diff --git a/src/nrek/NREK.template b/src/nrek/NREK.template index 5d30bc4543..61fe496e27 100644 --- a/src/nrek/NREK.template +++ b/src/nrek/NREK.template @@ -14,6 +14,6 @@ ! new-values F ! space-critical F ! deallocate-error-fatal F -! linear-equation-solver ssids -! linear-equation-solver-for-S ssids +! linear-equation-solver slblt +! linear-equation-solver-for-S slblt ! output-line-prefix "" diff --git a/src/nrek/nrek.F90 b/src/nrek/nrek.F90 index c6f3d54d07..36d8bd953d 100644 --- a/src/nrek/nrek.F90 +++ b/src/nrek/nrek.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.4 - 2025-11-22 AT 13:50 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 13:50 GMT. #include "galahad_modules.h" @@ -164,11 +164,11 @@ MODULE GALAHAD_NREK_precision ! symmetric linear equation solver for systems involving H - CHARACTER ( LEN = 30 ) :: linear_solver = "ssids" // REPEAT( ' ', 25 ) + CHARACTER ( LEN = 30 ) :: linear_solver = "slblt" // REPEAT( ' ', 25 ) ! symmetric linear equation solver for systems involving S (if needed) - CHARACTER ( LEN = 30 ) :: linear_solver_for_S = "ssids" // & + CHARACTER ( LEN = 30 ) :: linear_solver_for_S = "slblt" // & REPEAT( ' ', 25 ) ! all output lines will be prefixed by %prefix(2:LEN(TRIM(%prefix))-1) @@ -484,8 +484,8 @@ SUBROUTINE NREK_read_specfile( control, device, alt_specname ) ! new-values F ! space-critical F ! deallocate-error-fatal F -! linear-equation-solver ssids -! linear-equation-solver-for-S ssids +! linear-equation-solver slblt +! linear-equation-solver-for-S slblt ! output-line-prefix "" ! END NREK SPECIFICATIONS (DEFAULT) diff --git a/src/psls/PSLS.template b/src/psls/PSLS.template index 4e703338a5..6b97a73e10 100644 --- a/src/psls/PSLS.template +++ b/src/psls/PSLS.template @@ -20,6 +20,6 @@ ! get-norm-of-residual no ! space-critical no ! deallocate-error-fatal no -! symmetric-linear-equation-solver ssids -! definite-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt +! definite-linear-equation-solver slblt ! output-line-prefix "" diff --git a/src/psls/Python/psls_pyiface.c b/src/psls/Python/psls_pyiface.c index eedee1fe83..88031d3265 100644 --- a/src/psls/Python/psls_pyiface.c +++ b/src/psls/Python/psls_pyiface.c @@ -1,7 +1,7 @@ //* \file psls_pyiface.c */ /* - * THIS VERSION: GALAHAD 4.1 - 2023-05-20 AT 10:30 GMT. + * THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 10:30 GMT. * *-*-*-*-*-*-*-*-*- GALAHAD_PSLS PYTHON INTERFACE *-*-*-*-*-*-*-*-*-*- * @@ -638,11 +638,11 @@ PyDoc_STRVAR(psls_module_doc, "\n" "The method relies on a variety of well-known solvers \n" "from HSL and elsewhere. Currently supported solvers include MA27/SILS, \n" -"HSL_MA57, HSL_MA77 , HSL_MA86, HSL_MA87 and HSL_MA97 from HSL, SSIDS \n" -"from SPRAL, MUMPS from Mumps Technologies, PARDISO both from the \n" +"HSL_MA57, HSL_MA77 , HSL_MA86, HSL_MA87 and HSL_MA97 from HSL, SLBLT, \n" +"MUMPS from Mumps Technologies, PARDISO both from the \n" "Pardiso Project and Intel’s MKL, PaStiX from Inria, and WSMP from the \n" "IBM alpha Works, as well as POTR, SYTR and SBTR from LAPACK. Note\n" -"that, with the exception of SSIDS and the Netlib reference LAPACK codes, \n" +"that, with the exception of SLBLT and the Netlib reference LAPACK codes, \n" "the solvers themselves do not form part of this package and must be \n" "obtained/linked to separately. Dummy instances are provided for solvers \n" "that are unavailable.\n" diff --git a/src/psls/psls.F90 b/src/psls/psls.F90 index d3dbf6b755..8f2a0465f4 100644 --- a/src/psls/psls.F90 +++ b/src/psls/psls.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.5 - 2026-02-28 AT 09:50 GMT +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 09:50 GMT #include "galahad_modules.h" @@ -194,12 +194,12 @@ MODULE GALAHAD_PSLS_precision ! indefinite linear equation solver - CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "ssids" // & + CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "slblt" // & REPEAT( ' ', 25 ) ! definite linear equation solver - CHARACTER ( LEN = 30 ) :: definite_linear_solver = "ssids" // & + CHARACTER ( LEN = 30 ) :: definite_linear_solver = "slblt" // & REPEAT( ' ', 25 ) ! all output lines will be prefixed by diff --git a/src/qpa/QPA.template b/src/qpa/QPA.template index ca841cbd69..57ce065a9c 100644 --- a/src/qpa/QPA.template +++ b/src/qpa/QPA.template @@ -41,5 +41,5 @@ ! temporarily-perturb-constraint-bounds yes ! array-syntax-worse-than-do-loop no ! generate-sif-file no -! symmetric-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt ! sif-file-name QPAPROB.SIF diff --git a/src/qpa/qpa.F90 b/src/qpa/qpa.F90 index 68d0ab9245..bf8540e4ba 100644 --- a/src/qpa/qpa.F90 +++ b/src/qpa/qpa.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.1 - 2024-12-18 AT 10:40 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 10:40 GMT. #include "galahad_modules.h" @@ -366,12 +366,12 @@ MODULE GALAHAD_QPA_precision ! indefinite linear equation solver - CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "ssids" // & + CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "slblt" // & REPEAT( ' ', 25 ) ! definite linear equation solver -! CHARACTER ( LEN = 30 ) :: definite_linear_solver = "ssids" // & +! CHARACTER ( LEN = 30 ) :: definite_linear_solver = "slblt" // & ! REPEAT( ' ', 25 ) ! name of generated SIF file containing input problem diff --git a/src/qpb/qpbt.F90 b/src/qpb/qpbt.F90 index ebf2bbcd23..ad202e2809 100644 --- a/src/qpb/qpbt.F90 +++ b/src/qpb/qpbt.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 4.1 - 2023-02-11 AT 08:10 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 08:10 GMT. #include "galahad_modules.h" PROGRAM GALAHAD_QPB_EXAMPLE USE GALAHAD_KINDS_precision @@ -636,8 +636,8 @@ PROGRAM GALAHAD_QPB_EXAMPLE SUBROUTINE WHICH_sls( control ) TYPE ( QPB_control_type ) :: control #include "galahad_sls_defaults.h" -!symmetric_linear_solver = 'ssids' -!definite_linear_solver = 'ssids' +!symmetric_linear_solver = 'slblt' +!definite_linear_solver = 'slblt' control%FDC_control%use_sls = use_sls control%FDC_control%symmetric_linear_solver = symmetric_linear_solver control%SBLS_control%symmetric_linear_solver = symmetric_linear_solver diff --git a/src/rb/rb.F90 b/src/rb/rb.F90 index 5a00ddc7d0..cef359c5ab 100644 --- a/src/rb/rb.F90 +++ b/src/rb/rb.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.3 - 2025-08-31 AT 10:00 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 10:00 GMT. #include "galahad_modules.h" @@ -19,12 +19,12 @@ MODULE GALAHAD_RB_precision USE GALAHAD_KINDS_precision - USE GALAHAD_MU_precision, ONLY: SSIDS_MATRIX_UNSPECIFIED, & - SSIDS_MATRIX_REAL_RECT, & - SSIDS_MATRIX_REAL_UNSYM, & - SSIDS_MATRIX_REAL_SYM_PSDEF, & - SSIDS_MATRIX_REAL_SYM_INDEF, & - SSIDS_MATRIX_REAL_SKEW, & + USE GALAHAD_MU_precision, ONLY: SLBLT_MATRIX_UNSPECIFIED, & + SLBLT_MATRIX_REAL_RECT, & + SLBLT_MATRIX_REAL_UNSYM, & + SLBLT_MATRIX_REAL_SYM_PSDEF, & + SLBLT_MATRIX_REAL_SYM_INDEF, & + SLBLT_MATRIX_REAL_SKEW, & MU_half_to_full USE GALAHAD_RAND_precision, ONLY: RAND_random_state_lcg, & RAND_random_real_lcg @@ -1167,17 +1167,17 @@ CHARACTER( LEN = 1 ) FUNCTION matrix_type_to_sym( matrix_type ) INTEGER( ip_ ), INTENT( IN ) :: matrix_type SELECT CASE ( matrix_type ) - CASE( SSIDS_MATRIX_UNSPECIFIED ) + CASE( SLBLT_MATRIX_UNSPECIFIED ) matrix_type_to_sym = "r" - CASE( SSIDS_MATRIX_REAL_RECT ) + CASE( SLBLT_MATRIX_REAL_RECT ) matrix_type_to_sym = "r" - CASE( SSIDS_MATRIX_REAL_UNSYM ) + CASE( SLBLT_MATRIX_REAL_UNSYM ) matrix_type_to_sym = "u" - CASE( SSIDS_MATRIX_REAL_SYM_PSDEF ) + CASE( SLBLT_MATRIX_REAL_SYM_PSDEF ) matrix_type_to_sym = "s" - CASE( SSIDS_MATRIX_REAL_SYM_INDEF ) + CASE( SLBLT_MATRIX_REAL_SYM_INDEF ) matrix_type_to_sym = "s" - CASE( SSIDS_MATRIX_REAL_SKEW ) + CASE( SLBLT_MATRIX_REAL_SKEW ) matrix_type_to_sym = "z" END SELECT RETURN @@ -1195,15 +1195,15 @@ INTEGER FUNCTION sym_to_matrix_type( sym ) SELECT CASE ( sym ) CASE( "r" ) - sym_to_matrix_type = SSIDS_MATRIX_REAL_RECT + sym_to_matrix_type = SLBLT_MATRIX_REAL_RECT CASE( "s" ) - sym_to_matrix_type = SSIDS_MATRIX_REAL_SYM_INDEF + sym_to_matrix_type = SLBLT_MATRIX_REAL_SYM_INDEF CASE( "u" ) - sym_to_matrix_type = SSIDS_MATRIX_REAL_UNSYM + sym_to_matrix_type = SLBLT_MATRIX_REAL_UNSYM CASE( "z" ) - sym_to_matrix_type = SSIDS_MATRIX_REAL_SKEW + sym_to_matrix_type = SLBLT_MATRIX_REAL_SKEW CASE DEFAULT ! this should never happen - sym_to_matrix_type = SSIDS_MATRIX_UNSPECIFIED + sym_to_matrix_type = SLBLT_MATRIX_UNSPECIFIED END SELECT RETURN diff --git a/src/rqs/RQS.template b/src/rqs/RQS.template index ebbb909ac6..7534ce9de8 100644 --- a/src/rqs/RQS.template +++ b/src/rqs/RQS.template @@ -20,7 +20,7 @@ ! initialize-approximate-eigenvector yes ! space-critical no ! deallocate-error-fatal no -! symmetric-linear-equation-solver ssids -! definite-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt +! definite-linear-equation-solver slblt ! problem-file rqs_problem.data ! output-line-prefix "" diff --git a/src/rqs/rqs.F90 b/src/rqs/rqs.F90 index 6516824a49..ca823a1731 100644 --- a/src/rqs/rqs.F90 +++ b/src/rqs/rqs.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.4 - 2025-10-05 AT 09:15 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 09:15 GMT. #include "galahad_modules.h" @@ -227,12 +227,12 @@ MODULE GALAHAD_RQS_precision ! symmetric (indefinite) linear equation solver - CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "ssids" // & + CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "slblt" // & REPEAT( ' ', 25 ) ! definite linear equation solver - CHARACTER ( LEN = 30 ) :: definite_linear_solver = "ssids" // & + CHARACTER ( LEN = 30 ) :: definite_linear_solver = "slblt" // & REPEAT( ' ', 25 ) ! all output lines will be prefixed by diff --git a/src/rqs/rqst.F90 b/src/rqs/rqst.F90 index 8b6ad7e21b..24c2f3d236 100644 --- a/src/rqs/rqst.F90 +++ b/src/rqs/rqst.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.4 - 2025-10-03 AT 13:50 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 13:50 GMT. #include "galahad_modules.h" PROGRAM GALAHAD_RQS_test_deck USE GALAHAD_KINDS_precision @@ -322,7 +322,7 @@ PROGRAM GALAHAD_RQS_test_deck IF ( pass == 6 .OR. pass == 13 ) control%stop_normal = epsmch ** 0.666 CALL RQS_solve( n, p, sigma, f, C, H, X, data, control, inform, M = M ) -!write(6,*) 'ssids flag = ', inform%sls_inform%ssids_inform%flag +!write(6,*) 'slblt flag = ', inform%sls_inform%slblt_inform%flag !write( 6, * ) ' solver used is ', inform%sls_inform%solver WRITE( 6, "( ' pass ', I3, ': RQS_solve exit status = ', I6 )" ) & pass, inform%status diff --git a/src/sbls/SBLS.template b/src/sbls/SBLS.template index a2f594aac8..9a8b80b34d 100644 --- a/src/sbls/SBLS.template +++ b/src/sbls/SBLS.template @@ -21,7 +21,7 @@ ! get-norm-residual no ! space-critical no ! deallocate-error-fatal no -! symmetric-linear-equation-solver ssids -! definite-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt +! definite-linear-equation-solver slblt ! unsymmetric-linear-equation-solver gls ! output-line-prefix "" diff --git a/src/sbls/sbls.F90 b/src/sbls/sbls.F90 index 8d7e1d7ada..2100c8a968 100644 --- a/src/sbls/sbls.F90 +++ b/src/sbls/sbls.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.1 - 2024-11-18 AT 14:30 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 14:30 GMT. #include "galahad_modules.h" @@ -259,12 +259,12 @@ MODULE GALAHAD_SBLS_precision ! indefinite linear equation solver - CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "ssids" // & + CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "slblt" // & REPEAT( ' ', 25 ) ! definite linear equation solver - CHARACTER ( LEN = 30 ) :: definite_linear_solver = "ssids" // & + CHARACTER ( LEN = 30 ) :: definite_linear_solver = "slblt" // & REPEAT( ' ', 25 ) ! unsymmetric linear equation solver @@ -683,8 +683,8 @@ SUBROUTINE SBLS_read_specfile( control, device, alt_specname ) ! perturb-to-make-+ve-definite T ! space-critical F ! deallocate-error-fatal F -! symmetric-linear-equation-solver ssids -! definite-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt +! definite-linear-equation-solver slblt ! unsymmetric-linear-equation-solver gls ! output-line-prefix "" ! END SBLS SPECIFICATIONS diff --git a/src/sbls/sblst.F90 b/src/sbls/sblst.F90 index 2cf38405fd..cd56789d2c 100644 --- a/src/sbls/sblst.F90 +++ b/src/sbls/sblst.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.1 - 2024-11-23 AT 15:30 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 15:30 GMT. #include "galahad_modules.h" PROGRAM GALAHAD_SBLS_EXAMPLE USE GALAHAD_KINDS_precision @@ -447,7 +447,7 @@ PROGRAM GALAHAD_SBLS_EXAMPLE control%symmetric_linear_solver = 'ma86' control%definite_linear_solver = 'ma86' CASE ( 5 ) - control%symmetric_linear_solver = 'ssids' + control%symmetric_linear_solver = 'slblt' control%definite_linear_solver = 'ma87' CASE ( 6 ) control%symmetric_linear_solver = 'ma97' @@ -473,8 +473,8 @@ PROGRAM GALAHAD_SBLS_EXAMPLE CASE ( 13 ) CYCLE CASE ( 14 ) - control%symmetric_linear_solver = 'ssids' - control%definite_linear_solver = 'ssids' + control%symmetric_linear_solver = 'slblt' + control%definite_linear_solver = 'slblt' END SELECT IF ( ALLOCATED( H%type ) ) DEALLOCATE( H%type ) CALL SMT_put( H%type, 'COORDINATE', smt_stat ) ; H%ne = h_ne diff --git a/src/ssids/C/ssids_ciface.F90 b/src/slblt/C/slblt_ciface.F90 similarity index 68% rename from src/ssids/C/ssids_ciface.F90 rename to src/slblt/C/slblt_ciface.F90 index a7d725d196..fe8b45f655 100644 --- a/src/ssids/C/ssids_ciface.F90 +++ b/src/slblt/C/slblt_ciface.F90 @@ -1,46 +1,9 @@ -! THIS VERSION: GALAHAD 5.4 - 2025-11-29 AT 13:30 GMT - -#ifdef REAL_32 -#ifdef INTEGER_64 -#define GALAHAD_KINDS_precision GALAHAD_KINDS_single_64 -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_single_64 -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_single_ciface_64 -#define GALAHAD_NODEND_precision_ciface GALAHAD_NODEND_single_ciface_64 -#else -#define GALAHAD_KINDS_precision GALAHAD_KINDS_single -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_single -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_single_ciface -#define GALAHAD_NODEND_precision_ciface GALAHAD_NODEND_single_ciface -#endif -#elif REAL_128 -#ifdef INTEGER_64 -#define GALAHAD_KINDS_precision GALAHAD_KINDS_quadruple_64 -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_quadruple_64 -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_quadruple_ciface_64 -#define GALAHAD_NODEND_precision_ciface GALAHAD_NODEND_quadruple_ciface_64 -#else -#define GALAHAD_KINDS_precision GALAHAD_KINDS_quadruple -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_quadruple -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_quadruple_ciface -#define GALAHAD_NODEND_precision_ciface GALAHAD_NODEND_quadruple_ciface -#endif -#else -#ifdef INTEGER_64 -#define GALAHAD_KINDS_precision GALAHAD_KINDS_double_64 -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_double_64 -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_double_ciface_64 -#define GALAHAD_NODEND_precision_ciface GALAHAD_NODEND_double_ciface_64 -#else -#define GALAHAD_KINDS_precision GALAHAD_KINDS_double -#define GALAHAD_SSIDS_precision GALAHAD_SSIDS_double -#define GALAHAD_SSIDS_precision_ciface GALAHAD_SSIDS_double_ciface -#define GALAHAD_NODEND_precision_ciface GALAHAD_NODEND_double_ciface -#endif -#endif +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 13:30 GMT +#include "galahad_modules.h" #include "galahad_cfunctions.h" -!-*-*-*-*-*-*-*- G A L A H A D _ S S I D S C I N T E R F A C E -*-*-*-*-*- +!-*-*-*-*-*-*-*- G A L A H A D _ S L B L T C I N T E R F A C E -*-*-*-*-*- ! Copyright reserved, Gould/Orban/Toint, for GALAHAD productions ! Principal authors: Jaroslav Fowkes & Nick Gould @@ -51,29 +14,29 @@ ! For full documentation, see ! http://galahad.rl.ac.uk/galahad-www/specs.html -! C interface module to GALAHAD_SSIDS types and interfaces +! C interface module to GALAHAD_SLBLT types and interfaces - MODULE GALAHAD_SSIDS_precision_ciface + MODULE GALAHAD_SLBLT_precision_ciface USE GALAHAD_KINDS_precision - USE GALAHAD_SSIDS_precision, ONLY : f_ssids_analyse => SSIDS_analyse, & - f_ssids_analyse_coord & - => SSIDS_analyse_coord, & - f_ssids_factor => SSIDS_factor, & - f_ssids_solve => SSIDS_solve, & - f_ssids_free => SSIDS_free, & - f_ssids_enquire_posdef & - => SSIDS_enquire_posdef, & - f_ssids_enquire_indef & - => SSIDS_enquire_indef, & - f_ssids_alter => SSIDS_alter, & - f_ssids_control_type & - => SSIDS_control_type, & - f_ssids_inform_type & - => SSIDS_inform_type, & - f_ssids_akeep_type & - => SSIDS_akeep_type, & - f_ssids_fkeep_type & - => SSIDS_fkeep_type + USE GALAHAD_SLBLT_precision, ONLY : f_slblt_analyse => SLBLT_analyse, & + f_slblt_analyse_coord & + => SLBLT_analyse_coord, & + f_slblt_factor => SLBLT_factor, & + f_slblt_solve => SLBLT_solve, & + f_slblt_free => SLBLT_free, & + f_slblt_enquire_posdef & + => SLBLT_enquire_posdef, & + f_slblt_enquire_indef & + => SLBLT_enquire_indef, & + f_slblt_alter => SLBLT_alter, & + f_slblt_control_type & + => SLBLT_control_type, & + f_slblt_inform_type & + => SLBLT_inform_type, & + f_slblt_akeep_type & + => SLBLT_akeep_type, & + f_slblt_fkeep_type & + => SLBLT_fkeep_type USE GALAHAD_NODEND_precision_ciface, ONLY: & nodend_inform_type, nodend_control_type, & copy_nodend_control_in => copy_control_in, & @@ -86,7 +49,7 @@ MODULE GALAHAD_SSIDS_precision_ciface ! D e r i v e d t y p e d e f i n i t i o n s !------------------------------------------------- - TYPE, BIND( C ) :: ssids_control_type + TYPE, BIND( C ) :: slblt_control_type INTEGER ( KIND = ipc_ ) :: array_base INTEGER ( KIND = ipc_ ) :: print_level INTEGER ( KIND = ipc_ ) :: unit_diagnostics @@ -95,28 +58,23 @@ MODULE GALAHAD_SSIDS_precision_ciface INTEGER ( KIND = ipc_ ) :: ordering INTEGER ( KIND = ipc_ ) :: nemin LOGICAL ( KIND = C_BOOL ) :: ignore_numa - LOGICAL ( KIND = C_BOOL ) :: use_gpu - LOGICAL ( KIND = C_BOOL ) :: gpu_only - INTEGER ( KIND = longc_ ) :: min_gpu_work REAL ( KIND = spc_ ) :: max_load_inbalance - REAL ( KIND = spc_ ) :: gpu_perf_coeff INTEGER ( KIND = ipc_ ) :: scaling INTEGER ( KIND = longc_ ) :: small_subtree_threshold - INTEGER ( KIND = ipc_ ) :: cpu_block_size + INTEGER ( KIND = ipc_ ) :: block_size LOGICAL ( KIND = C_BOOL ) :: action INTEGER ( KIND = ipc_ ) :: pivot_method REAL ( KIND = rpc_ ) :: small REAL ( KIND = rpc_ ) :: u TYPE ( nodend_control_type ) :: nodend_control - INTEGER ( KIND = ipc_ ) :: nstream REAL ( KIND = rpc_ ) :: multiplier ! type(auction_control) :: auction REAL ( KIND = spc_ ) :: min_loadbalance ! character(len=:), allocatable :: rb_dump INTEGER ( KIND = ipc_ ) :: failed_pivot_method - END TYPE ssids_control_type + END TYPE slblt_control_type - TYPE, BIND( C ) :: ssids_inform_type + TYPE, BIND( C ) :: slblt_inform_type INTEGER ( KIND = ipc_ ) :: flag INTEGER ( KIND = ipc_ ) :: matrix_dup INTEGER ( KIND = ipc_ ) :: matrix_missing_diag @@ -133,16 +91,13 @@ MODULE GALAHAD_SSIDS_precision_ciface INTEGER ( KIND = ipc_ ) :: num_two INTEGER ( KIND = ipc_ ) :: stat ! type(auction_inform) :: auction - INTEGER ( KIND = ipc_ ) :: cuda_error - INTEGER ( KIND = ipc_ ) :: cublas_error TYPE ( nodend_inform_type ) :: nodend_inform INTEGER ( KIND = ipc_ ) :: not_first_pass INTEGER ( KIND = ipc_ ) :: not_second_pass INTEGER ( KIND = ipc_ ) :: nparts - INTEGER ( KIND = longc_ ) :: cpu_flops - INTEGER ( KIND = longc_ ) :: gpu_flops + INTEGER ( KIND = longc_ ) :: flops ! CHARACTER(C_CHAR) :: unused(76) - END TYPE ssids_inform_type + END TYPE slblt_inform_type !---------------------- ! P r o c e d u r e s @@ -153,8 +108,8 @@ MODULE GALAHAD_SSIDS_precision_ciface ! copy C options parameters to fortran SUBROUTINE copy_control_in( ccontrol, fcontrol, cindexed ) - TYPE ( ssids_control_type ), INTENT( IN ) :: ccontrol - TYPE ( f_ssids_control_type ), INTENT( OUT ) :: fcontrol + TYPE ( slblt_control_type ), INTENT( IN ) :: ccontrol + TYPE ( f_slblt_control_type ), INTENT( OUT ) :: fcontrol LOGICAL, INTENT( OUT ) :: cindexed cindexed = ccontrol%array_base == 0 @@ -165,21 +120,16 @@ SUBROUTINE copy_control_in( ccontrol, fcontrol, cindexed ) fcontrol%ordering = ccontrol%ordering fcontrol%nemin = ccontrol%nemin fcontrol%ignore_numa = ccontrol%ignore_numa - fcontrol%use_gpu = ccontrol%use_gpu - fcontrol%gpu_only = ccontrol%gpu_only - fcontrol%min_gpu_work = ccontrol%min_gpu_work fcontrol%max_load_inbalance = ccontrol%max_load_inbalance - fcontrol%gpu_perf_coeff = ccontrol%gpu_perf_coeff fcontrol%scaling = ccontrol%scaling fcontrol%small_subtree_threshold = ccontrol%small_subtree_threshold - fcontrol%cpu_block_size = ccontrol%cpu_block_size + fcontrol%block_size = ccontrol%block_size fcontrol%action = ccontrol%action fcontrol%pivot_method = ccontrol%pivot_method fcontrol%small = ccontrol%small fcontrol%u = ccontrol%u CALL copy_nodend_control_in( ccontrol%nodend_control, & fcontrol%nodend_control ) - fcontrol%nstream = ccontrol%nstream fcontrol%multiplier = ccontrol%multiplier fcontrol%min_loadbalance = REAL( ccontrol%min_loadbalance ) fcontrol%failed_pivot_method = ccontrol%failed_pivot_method @@ -190,8 +140,8 @@ END SUBROUTINE copy_control_in ! copy fortran information parameters to C SUBROUTINE copy_inform_out( finform, cinform ) - TYPE ( f_ssids_inform_type ), INTENT( IN ) :: finform - TYPE ( ssids_inform_type ), INTENT( OUT ) :: cinform + TYPE ( f_slblt_inform_type ), INTENT( IN ) :: finform + TYPE ( slblt_inform_type ), INTENT( OUT ) :: cinform cinform%flag = finform%flag cinform%matrix_dup = finform%matrix_dup @@ -208,35 +158,32 @@ SUBROUTINE copy_inform_out( finform, cinform ) cinform%num_sup = finform%num_sup cinform%num_two = finform%num_two cinform%stat = finform%stat - cinform%cuda_error = finform%cuda_error - cinform%cublas_error = finform%cublas_error CALL copy_nodend_inform_out( finform%nodend_inform, cinform%nodend_inform ) cinform%not_first_pass = finform%not_first_pass cinform%not_second_pass = finform%not_second_pass cinform%nparts = finform%nparts - cinform%cpu_flops = finform%cpu_flops - cinform%gpu_flops = finform%gpu_flops + cinform%flops = finform%flops RETURN END SUBROUTINE copy_inform_out - END MODULE GALAHAD_SSIDS_precision_ciface + END MODULE GALAHAD_SLBLT_precision_ciface ! ------------------ ! Revitalize options ! ------------------ - SUBROUTINE ssids_default_control( ccontrol ) BIND( C ) - USE GALAHAD_SSIDS_precision_ciface + SUBROUTINE slblt_default_control( ccontrol ) BIND( C ) + USE GALAHAD_SLBLT_precision_ciface IMPLICIT NONE ! dummy arguments - TYPE ( ssids_control_type ), INTENT( OUT ) :: ccontrol + TYPE ( slblt_control_type ), INTENT( OUT ) :: ccontrol ! local variables - TYPE ( f_ssids_control_type ) :: default_control + TYPE ( f_slblt_control_type ) :: default_control ccontrol%array_base = 0 ! C ccontrol%print_level = default_control%print_level @@ -246,32 +193,28 @@ SUBROUTINE ssids_default_control( ccontrol ) BIND( C ) ccontrol%ordering = default_control%ordering ccontrol%nemin = default_control%nemin ccontrol%ignore_numa = default_control%ignore_numa - ccontrol%use_gpu = default_control%use_gpu - ccontrol%min_gpu_work = default_control%min_gpu_work ccontrol%max_load_inbalance = default_control%max_load_inbalance - ccontrol%gpu_perf_coeff = default_control%gpu_perf_coeff ccontrol%scaling = default_control%scaling ccontrol%small_subtree_threshold = default_control%small_subtree_threshold - ccontrol%cpu_block_size = default_control%cpu_block_size + ccontrol%block_size = default_control%block_size ccontrol%action = default_control%action ccontrol%pivot_method = default_control%pivot_method ccontrol%small = default_control%small ccontrol%u = default_control%u CALL copy_nodend_control_out( default_control%nodend_control, & ccontrol%nodend_control ) - ccontrol%nstream = default_control%nstream ccontrol%multiplier = default_control%multiplier ccontrol%min_loadbalance = default_control%min_loadbalance ccontrol%failed_pivot_method = default_control%failed_pivot_method - END SUBROUTINE ssids_default_control + END SUBROUTINE slblt_default_control ! ------------------------------------ -! C interface to fortran ssids_analyse +! C interface to fortran slblt_analyse ! ------------------------------------ - SUBROUTINE ssids_analyse( ccheck, n, corder, cptr, crow, cval, & + SUBROUTINE slblt_analyse( ccheck, n, corder, cptr, crow, cval, & cakeep, ccontrol, cinform ) BIND( C ) - USE GALAHAD_SSIDS_precision_ciface + USE GALAHAD_SLBLT_precision_ciface IMPLICIT NONE ! dummy arguments @@ -282,8 +225,8 @@ SUBROUTINE ssids_analyse( ccheck, n, corder, cptr, crow, cval, & INTEGER ( KIND = longc_ ), TARGET, DIMENSION( n + 1 ) :: cptr TYPE ( C_PTR ), value :: cval TYPE ( C_PTR ), INTENT( INOUT ) :: cakeep - TYPE ( ssids_control_type ), INTENT( IN ) :: ccontrol - TYPE ( ssids_inform_type ), INTENT( OUT ) :: cinform + TYPE ( slblt_control_type ), INTENT( IN ) :: ccontrol + TYPE ( slblt_inform_type ), INTENT( OUT ) :: cinform INTEGER ( KIND = ipc_ ), TARGET, & DIMENSION( cptr( n + 1 ) - ccontrol%array_base ) :: crow @@ -297,9 +240,9 @@ SUBROUTINE ssids_analyse( ccheck, n, corder, cptr, crow, cval, & INTEGER ( KIND = ipc_ ), DIMENSION( : ), POINTER :: forder INTEGER ( KIND = ipc_ ), DIMENSION( : ), ALLOCATABLE, TARGET :: forder_alloc REAL ( KIND = rpc_ ), DIMENSION( : ), POINTER :: fval - TYPE ( f_ssids_akeep_type ), POINTER :: fakeep - TYPE ( f_ssids_control_type ) :: fcontrol - TYPE ( f_ssids_inform_type ) :: finform + TYPE ( f_slblt_akeep_type ), POINTER :: fakeep + TYPE ( f_slblt_control_type ) :: fcontrol + TYPE ( f_slblt_inform_type ) :: finform LOGICAL :: cindexed ! copy control in first to find out whether we use fortran or C indexing @@ -357,18 +300,18 @@ SUBROUTINE ssids_analyse( ccheck, n, corder, cptr, crow, cval, & close(99) IF ( ASSOCIATED( forder ) ) THEN IF ( ASSOCIATED( fval ) ) THEN - CALL f_ssids_analyse( fcheck, n, fptr, frow, fakeep, fcontrol, finform, & + CALL f_slblt_analyse( fcheck, n, fptr, frow, fakeep, fcontrol, finform, & order = forder, val = fval ) ELSE - CALL f_ssids_analyse( fcheck, n, fptr, frow, fakeep, fcontrol, finform, & + CALL f_slblt_analyse( fcheck, n, fptr, frow, fakeep, fcontrol, finform, & order = forder ) END IF ELSE IF (ASSOCIATED(fval)) THEN - CALL f_ssids_analyse( fcheck, n, fptr, frow, fakeep, fcontrol, finform, & + CALL f_slblt_analyse( fcheck, n, fptr, frow, fakeep, fcontrol, finform, & val = fval ) ELSE - CALL f_ssids_analyse( fcheck, n, fptr, frow, fakeep, fcontrol, finform ) + CALL f_slblt_analyse( fcheck, n, fptr, frow, fakeep, fcontrol, finform ) END IF END IF @@ -380,15 +323,15 @@ SUBROUTINE ssids_analyse( ccheck, n, corder, cptr, crow, cval, & END IF CALL copy_inform_out( finform, cinform ) - END SUBROUTINE ssids_analyse + END SUBROUTINE slblt_analyse ! --------------------------------------------------------- ! C interface to fortrans sids_analyse with 32-bit pointers ! --------------------------------------------------------- - SUBROUTINE ssids_analyse_ptr32( ccheck, n, corder, cptr, crow, cval, & + SUBROUTINE slblt_analyse_ptr32( ccheck, n, corder, cptr, crow, cval, & cakeep, ccontrol, cinform ) BIND( C ) - USE GALAHAD_SSIDS_precision_ciface + USE GALAHAD_SLBLT_precision_ciface IMPLICIT NONE ! dummy arguments @@ -399,8 +342,8 @@ SUBROUTINE ssids_analyse_ptr32( ccheck, n, corder, cptr, crow, cval, & INTEGER ( KIND = ipc_ ), TARGET, DIMENSION( n + 1 ) :: cptr TYPE ( C_PTR ), VALUE :: cval TYPE ( C_PTR ), INTENT( INOUT ) :: cakeep - TYPE ( ssids_control_type ), INTENT( IN ) :: ccontrol - TYPE ( ssids_inform_type ), INTENT( OUT ) :: cinform + TYPE ( slblt_control_type ), INTENT( IN ) :: ccontrol + TYPE ( slblt_inform_type ), INTENT( OUT ) :: cinform INTEGER ( KIND = ipc_ ), TARGET, & DIMENSION( cptr( n + 1 ) - ccontrol%array_base ) :: crow @@ -414,9 +357,9 @@ SUBROUTINE ssids_analyse_ptr32( ccheck, n, corder, cptr, crow, cval, & INTEGER ( KIND = ipc_ ), DIMENSION( : ), POINTER :: forder INTEGER ( KIND = ipc_ ), DIMENSION( : ), ALLOCATABLE, TARGET :: forder_alloc REAL ( KIND = rpc_ ), DIMENSION( : ), POINTER :: fval - TYPE ( f_ssids_akeep_type ), POINTER :: fakeep - TYPE ( f_ssids_control_type ) :: fcontrol - TYPE ( f_ssids_inform_type ) :: finform + TYPE ( f_slblt_akeep_type ), POINTER :: fakeep + TYPE ( f_slblt_control_type ) :: fcontrol + TYPE ( f_slblt_inform_type ) :: finform LOGICAL :: cindexed @@ -471,18 +414,18 @@ SUBROUTINE ssids_analyse_ptr32( ccheck, n, corder, cptr, crow, cval, & IF ( ASSOCIATED( forder ) ) THEN IF ( ASSOCIATED( fval ) ) THEN - CALL f_ssids_analyse( fcheck, n, fptr, frow, fakeep, fcontrol, finform, & + CALL f_slblt_analyse( fcheck, n, fptr, frow, fakeep, fcontrol, finform, & order = forder, val = fval ) ELSE - CALL f_ssids_analyse( fcheck, n, fptr, frow, fakeep, fcontrol, finform, & + CALL f_slblt_analyse( fcheck, n, fptr, frow, fakeep, fcontrol, finform, & order = forder ) END IF ELSE IF ( ASSOCIATED( fval ) ) THEN - CALL f_ssids_analyse( fcheck, n, fptr, frow, fakeep, fcontrol, finform, & + CALL f_slblt_analyse( fcheck, n, fptr, frow, fakeep, fcontrol, finform, & val = fval ) ELSE - CALL f_ssids_analyse( fcheck, n, fptr, frow, fakeep, fcontrol, finform ) + CALL f_slblt_analyse( fcheck, n, fptr, frow, fakeep, fcontrol, finform ) END IF END IF @@ -494,15 +437,15 @@ SUBROUTINE ssids_analyse_ptr32( ccheck, n, corder, cptr, crow, cval, & END IF CALL copy_inform_out( finform, cinform ) - END SUBROUTINE ssids_analyse_ptr32 + END SUBROUTINE slblt_analyse_ptr32 ! ------------------------------------------ ! C interface to fortrans sids_analyse_coord ! ------------------------------------------ - SUBROUTINE ssids_analyse_coord( n, corder, ne, crow, ccol, cval, & + SUBROUTINE slblt_analyse_coord( n, corder, ne, crow, ccol, cval, & cakeep, ccontrol, cinform ) BIND( C ) - USE GALAHAD_SSIDS_precision_ciface + USE GALAHAD_SLBLT_precision_ciface IMPLICIT NONE ! dummy arguments @@ -514,8 +457,8 @@ SUBROUTINE ssids_analyse_coord( n, corder, ne, crow, ccol, cval, & INTEGER ( KIND = ipc_ ), TARGET, DIMENSION( ne ) :: ccol TYPE ( C_PTR ), VALUE :: cval TYPE ( C_PTR ), INTENT( INOUT ) :: cakeep - TYPE ( ssids_control_type ), INTENT( IN ) :: ccontrol - TYPE ( ssids_inform_type ), INTENT( OUT ) :: cinform + TYPE ( slblt_control_type ), INTENT( IN ) :: ccontrol + TYPE ( slblt_inform_type ), INTENT( OUT ) :: cinform ! local variables @@ -526,9 +469,9 @@ SUBROUTINE ssids_analyse_coord( n, corder, ne, crow, ccol, cval, & INTEGER ( KIND = ipc_ ), DIMENSION( : ), POINTER :: forder INTEGER ( KIND = ipc_ ), DIMENSION( : ), ALLOCATABLE, TARGET :: forder_alloc REAL ( KIND = rpc_ ), DIMENSION( : ), POINTER :: fval - TYPE ( f_ssids_akeep_type ), POINTER :: fakeep - TYPE ( f_ssids_control_type ) :: fcontrol - TYPE ( f_ssids_inform_type ) :: finform + TYPE ( f_slblt_akeep_type ), POINTER :: fakeep + TYPE ( f_slblt_control_type ) :: fcontrol + TYPE ( f_slblt_inform_type ) :: finform LOGICAL :: cindexed @@ -582,18 +525,18 @@ SUBROUTINE ssids_analyse_coord( n, corder, ne, crow, ccol, cval, & IF ( ASSOCIATED( forder ) ) THEN IF ( ASSOCIATED( fval ) ) THEN - CALL f_ssids_analyse_coord( n, ne, frow, fcol, fakeep, fcontrol, & + CALL f_slblt_analyse_coord( n, ne, frow, fcol, fakeep, fcontrol, & finform, order = forder, val = fval ) ELSE - CALL f_ssids_analyse_coord( n, ne, frow, fcol, fakeep, fcontrol, & + CALL f_slblt_analyse_coord( n, ne, frow, fcol, fakeep, fcontrol, & finform, order = forder ) END IF ELSE IF ( ASSOCIATED( fval ) ) THEN - CALL f_ssids_analyse_coord( n, ne, frow, fcol, fakeep, fcontrol, & + CALL f_slblt_analyse_coord( n, ne, frow, fcol, fakeep, fcontrol, & finform, val = fval ) ELSE - CALL f_ssids_analyse_coord( n, ne, frow, fcol, fakeep, fcontrol, finform ) + CALL f_slblt_analyse_coord( n, ne, frow, fcol, fakeep, fcontrol, finform ) END IF END IF @@ -605,15 +548,15 @@ SUBROUTINE ssids_analyse_coord( n, corder, ne, crow, ccol, cval, & END IF CALL copy_inform_out( finform, cinform ) - END SUBROUTINE ssids_analyse_coord + END SUBROUTINE slblt_analyse_coord ! ----------------------------------- -! C interface to fortran ssids_factor +! C interface to fortran slblt_factor ! ----------------------------------- - SUBROUTINE ssids_factor( cposdef, cptr, crow, val, cscale, cakeep, & + SUBROUTINE slblt_factor( cposdef, cptr, crow, val, cscale, cakeep, & cfkeep, ccontrol, cinform ) BIND( C ) - USE GALAHAD_SSIDS_precision_ciface + USE GALAHAD_SLBLT_precision_ciface IMPLICIT NONE ! dummy arguments @@ -625,8 +568,8 @@ SUBROUTINE ssids_factor( cposdef, cptr, crow, val, cscale, cakeep, & TYPE ( C_PTR ), VALUE :: cscale TYPE ( C_PTR ), VALUE :: cakeep TYPE ( C_PTR ), INTENT( INOUT ) :: cfkeep - TYPE ( ssids_control_type ), INTENT( IN ) :: ccontrol - TYPE ( ssids_inform_type ), INTENT( OUT ) :: cinform + TYPE ( slblt_control_type ), INTENT( IN ) :: ccontrol + TYPE ( slblt_inform_type ), INTENT( OUT ) :: cinform ! local variables @@ -636,10 +579,10 @@ SUBROUTINE ssids_factor( cposdef, cptr, crow, val, cscale, cakeep, & INTEGER ( KIND = ipc_ ), DIMENSION( : ), POINTER :: frow INTEGER ( KIND = ipc_ ), DIMENSION( : ), ALLOCATABLE, TARGET :: frow_alloc REAL ( KIND = rpc_ ), DIMENSION( : ), POINTER :: fscale - TYPE ( f_ssids_akeep_type ), POINTER :: fakeep - TYPE ( f_ssids_fkeep_type ), POINTER :: ffkeep - TYPE ( f_ssids_control_type ) :: fcontrol - TYPE ( f_ssids_inform_type ) :: finform + TYPE ( f_slblt_akeep_type ), POINTER :: fakeep + TYPE ( f_slblt_fkeep_type ), POINTER :: ffkeep + TYPE ( f_slblt_control_type ) :: fcontrol + TYPE ( f_slblt_inform_type ) :: finform LOGICAL :: cindexed @@ -691,18 +634,18 @@ SUBROUTINE ssids_factor( cposdef, cptr, crow, val, cscale, cakeep, & IF ( ASSOCIATED( fptr ) .AND. ASSOCIATED( frow ) ) THEN IF ( ASSOCIATED( fscale ) ) THEN - CALL f_ssids_factor( fposdef, val, fakeep, ffkeep, fcontrol, finform, & + CALL f_slblt_factor( fposdef, val, fakeep, ffkeep, fcontrol, finform, & ptr = fptr, row = frow, scale = fscale ) ELSE - CALL f_ssids_factor( fposdef, val, fakeep, ffkeep, fcontrol, finform, & + CALL f_slblt_factor( fposdef, val, fakeep, ffkeep, fcontrol, finform, & ptr = fptr, row = frow ) END IF ELSE IF ( ASSOCIATED( fscale ) ) THEN - CALL f_ssids_factor( fposdef, val, fakeep, ffkeep, fcontrol, finform, & + CALL f_slblt_factor( fposdef, val, fakeep, ffkeep, fcontrol, finform, & scale = fscale ) ELSE - CALL f_ssids_factor( fposdef, val, fakeep, ffkeep, fcontrol, finform ) + CALL f_slblt_factor( fposdef, val, fakeep, ffkeep, fcontrol, finform ) END IF END IF write(99, "( ' after factor ' )" ) @@ -712,15 +655,15 @@ SUBROUTINE ssids_factor( cposdef, cptr, crow, val, cscale, cakeep, & CALL copy_inform_out(finform, cinform) - END SUBROUTINE ssids_factor + END SUBROUTINE slblt_factor ! -------------------------------------------------------- -! C interface to fortran ssids_factor with 32-bit pointers +! C interface to fortran slblt_factor with 32-bit pointers ! -------------------------------------------------------- - SUBROUTINE ssids_factor_ptr32( cposdef, cptr, crow, val, cscale, cakeep, & + SUBROUTINE slblt_factor_ptr32( cposdef, cptr, crow, val, cscale, cakeep, & cfkeep, ccontrol, cinform ) BIND( C ) - USE GALAHAD_SSIDS_precision_ciface + USE GALAHAD_SLBLT_precision_ciface IMPLICIT NONE ! dummy arguments @@ -732,8 +675,8 @@ SUBROUTINE ssids_factor_ptr32( cposdef, cptr, crow, val, cscale, cakeep, & TYPE ( C_PTR ), VALUE :: cscale TYPE ( C_PTR ), VALUE :: cakeep TYPE ( C_PTR ), INTENT( INOUT ) :: cfkeep - TYPE ( ssids_control_type ), INTENT( IN ) :: ccontrol - TYPE ( ssids_inform_type ), INTENT( OUT ) :: cinform + TYPE ( slblt_control_type ), INTENT( IN ) :: ccontrol + TYPE ( slblt_inform_type ), INTENT( OUT ) :: cinform ! local variables @@ -743,10 +686,10 @@ SUBROUTINE ssids_factor_ptr32( cposdef, cptr, crow, val, cscale, cakeep, & INTEGER ( KIND = ipc_ ), DIMENSION( : ), POINTER :: frow INTEGER ( KIND = ipc_ ), DIMENSION( : ), ALLOCATABLE, TARGET :: frow_alloc REAL ( KIND = rpc_ ), DIMENSION( : ), POINTER :: fscale - TYPE ( f_ssids_akeep_type ), POINTER :: fakeep - TYPE ( f_ssids_fkeep_type ), POINTER :: ffkeep - TYPE ( f_ssids_control_type ) :: fcontrol - TYPE ( f_ssids_inform_type ) :: finform + TYPE ( f_slblt_akeep_type ), POINTER :: fakeep + TYPE ( f_slblt_fkeep_type ), POINTER :: ffkeep + TYPE ( f_slblt_control_type ) :: fcontrol + TYPE ( f_slblt_inform_type ) :: finform LOGICAL :: cindexed @@ -796,18 +739,18 @@ SUBROUTINE ssids_factor_ptr32( cposdef, cptr, crow, val, cscale, cakeep, & IF ( ASSOCIATED( fptr ) .AND. ASSOCIATED( frow ) ) THEN IF ( ASSOCIATED( fscale ) ) THEN - CALL f_ssids_factor( fposdef, val, fakeep, ffkeep, fcontrol, finform, & + CALL f_slblt_factor( fposdef, val, fakeep, ffkeep, fcontrol, finform, & ptr = fptr, row = frow, scale = fscale ) ELSE - CALL f_ssids_factor( fposdef, val, fakeep, ffkeep, fcontrol, finform, & + CALL f_slblt_factor( fposdef, val, fakeep, ffkeep, fcontrol, finform, & ptr = fptr, row = frow ) END IF ELSE IF ( ASSOCIATED( fscale ) ) THEN - CALL f_ssids_factor( fposdef, val, fakeep, ffkeep, fcontrol, finform, & + CALL f_slblt_factor( fposdef, val, fakeep, ffkeep, fcontrol, finform, & scale = fscale ) ELSE - CALL f_ssids_factor( fposdef, val, fakeep, ffkeep, fcontrol, finform ) + CALL f_slblt_factor( fposdef, val, fakeep, ffkeep, fcontrol, finform ) END IF END IF @@ -815,15 +758,15 @@ SUBROUTINE ssids_factor_ptr32( cposdef, cptr, crow, val, cscale, cakeep, & CALL copy_inform_out( finform, cinform ) - END SUBROUTINE ssids_factor_ptr32 + END SUBROUTINE slblt_factor_ptr32 ! --------------------------------------------------------------- -! C interface to fortran galahad_ssids_solve with 1 right-hand side +! C interface to fortran galahad_slblt_solve with 1 right-hand side ! --------------------------------------------------------------- - SUBROUTINE ssids_solve1( job, cx1, cakeep, cfkeep, ccontrol, & + SUBROUTINE slblt_solve1( job, cx1, cakeep, cfkeep, ccontrol, & cinform ) BIND( C ) - USE GALAHAD_SSIDS_precision_ciface + USE GALAHAD_SLBLT_precision_ciface IMPLICIT NONE ! dummy arguments @@ -832,16 +775,16 @@ SUBROUTINE ssids_solve1( job, cx1, cakeep, cfkeep, ccontrol, & REAL ( KIND = rpc_ ), TARGET, DIMENSION( * ) :: cx1 TYPE ( C_PTR ), VALUE :: cakeep TYPE ( C_PTR ), VALUE :: cfkeep - TYPE ( ssids_control_type ), INTENT( IN ) :: ccontrol - TYPE ( ssids_inform_type ), INTENT( OUT ) :: cinform + TYPE ( slblt_control_type ), INTENT( IN ) :: ccontrol + TYPE ( slblt_inform_type ), INTENT( OUT ) :: cinform ! local variables REAL ( KIND = rpc_ ), DIMENSION( : ), POINTER :: fx1 - TYPE ( f_ssids_akeep_type ), POINTER :: fakeep - TYPE ( f_ssids_fkeep_type ), POINTER :: ffkeep - TYPE ( f_ssids_control_type ) :: fcontrol - TYPE ( f_ssids_inform_type ) :: finform + TYPE ( f_slblt_akeep_type ), POINTER :: fakeep + TYPE ( f_slblt_fkeep_type ), POINTER :: ffkeep + TYPE ( f_slblt_control_type ) :: fcontrol + TYPE ( f_slblt_inform_type ) :: finform LOGICAL :: cindexed @@ -869,24 +812,24 @@ SUBROUTINE ssids_solve1( job, cx1, cakeep, cfkeep, ccontrol, & ! note: job=0 is an out of range value (but is valid internally!) - CALL f_ssids_solve( fx1, fakeep, ffkeep, fcontrol, finform ) + CALL f_slblt_solve( fx1, fakeep, ffkeep, fcontrol, finform ) ELSE - CALL f_ssids_solve( fx1, fakeep, ffkeep, fcontrol, finform, job = job ) + CALL f_slblt_solve( fx1, fakeep, ffkeep, fcontrol, finform, job = job ) END IF ! copy arguments out CALL copy_inform_out(finform, cinform) - END SUBROUTINE ssids_solve1 + END SUBROUTINE slblt_solve1 ! ----------------------------------------------------------------------- -! C interface to fortran galahad_ssids_solve with multiple right-hand sides +! C interface to fortran galahad_slblt_solve with multiple right-hand sides ! ----------------------------------------------------------------------- - SUBROUTINE ssids_solve( job, nrhs, x, ldx, cakeep, cfkeep, ccontrol, & + SUBROUTINE slblt_solve( job, nrhs, x, ldx, cakeep, cfkeep, ccontrol, & cinform ) BIND( C ) - USE GALAHAD_SSIDS_precision_ciface + USE GALAHAD_SLBLT_precision_ciface IMPLICIT NONE ! dummy arguments @@ -897,15 +840,15 @@ SUBROUTINE ssids_solve( job, nrhs, x, ldx, cakeep, cfkeep, ccontrol, & INTEGER ( KIND = ipc_ ), VALUE :: ldx TYPE ( C_PTR ), VALUE :: cakeep TYPE ( C_PTR ), VALUE :: cfkeep - TYPE ( ssids_control_type ), INTENT( IN ) :: ccontrol - TYPE ( ssids_inform_type ), INTENT( OUT ) :: cinform + TYPE ( slblt_control_type ), INTENT( IN ) :: ccontrol + TYPE ( slblt_inform_type ), INTENT( OUT ) :: cinform ! local variables - TYPE ( f_ssids_akeep_type ), POINTER :: fakeep - TYPE ( f_ssids_fkeep_type ), POINTER :: ffkeep - TYPE ( f_ssids_control_type ) :: fcontrol - TYPE ( f_ssids_inform_type ) :: finform + TYPE ( f_slblt_akeep_type ), POINTER :: fakeep + TYPE ( f_slblt_fkeep_type ), POINTER :: ffkeep + TYPE ( f_slblt_control_type ) :: fcontrol + TYPE ( f_slblt_inform_type ) :: finform LOGICAL :: cindexed @@ -929,9 +872,9 @@ SUBROUTINE ssids_solve( job, nrhs, x, ldx, cakeep, cfkeep, ccontrol, & ! call fortran routine IF ( job == 0 ) THEN - CALL f_ssids_solve( nrhs, x, ldx, fakeep, ffkeep, fcontrol, finform ) + CALL f_slblt_solve( nrhs, x, ldx, fakeep, ffkeep, fcontrol, finform ) ELSE - CALL f_ssids_solve( nrhs, x, ldx, fakeep, ffkeep, fcontrol, finform, & + CALL f_slblt_solve( nrhs, x, ldx, fakeep, ffkeep, fcontrol, finform, & job = job ) END IF @@ -939,14 +882,14 @@ SUBROUTINE ssids_solve( job, nrhs, x, ldx, cakeep, cfkeep, ccontrol, & CALL copy_inform_out( finform, cinform ) - END SUBROUTINE ssids_solve + END SUBROUTINE slblt_solve ! ------------------------------------------------ -! C interface to fortran ssids_free to free cakeep +! C interface to fortran slblt_free to free cakeep ! ------------------------------------------------ - INTEGER ( KIND = ipc_ ) function ssids_free_akeep( cakeep ) BIND( C ) - USE GALAHAD_SSIDS_precision_ciface + INTEGER ( KIND = ipc_ ) function slblt_free_akeep( cakeep ) BIND( C ) + USE GALAHAD_SLBLT_precision_ciface IMPLICIT NONE ! dummy arguments @@ -955,28 +898,28 @@ INTEGER ( KIND = ipc_ ) function ssids_free_akeep( cakeep ) BIND( C ) ! local variables - TYPE ( f_ssids_akeep_type ), POINTER :: fakeep + TYPE ( f_slblt_akeep_type ), POINTER :: fakeep ! nothing to free IF ( .NOT. C_ASSOCIATED( cakeep ) ) THEN - ssids_free_akeep = 0 + slblt_free_akeep = 0 RETURN END IF CALL C_F_POINTER( cakeep, fakeep ) - CALL f_ssids_free( fakeep, ssids_free_akeep ) + CALL f_slblt_free( fakeep, slblt_free_akeep ) DEALLOCATE( fakeep ) cakeep = C_NULL_PTR - END FUNCTION ssids_free_akeep + END FUNCTION slblt_free_akeep ! ------------------------------------------------ -! C interface to fortran ssids_free to free cfkeep +! C interface to fortran slblt_free to free cfkeep ! ------------------------------------------------ - INTEGER ( KIND = ipc_ ) function ssids_free_fkeep( cfkeep ) BIND( C ) - USE GALAHAD_SSIDS_precision_ciface + INTEGER ( KIND = ipc_ ) function slblt_free_fkeep( cfkeep ) BIND( C ) + USE GALAHAD_SLBLT_precision_ciface IMPLICIT NONE ! dummy arguments @@ -985,28 +928,28 @@ INTEGER ( KIND = ipc_ ) function ssids_free_fkeep( cfkeep ) BIND( C ) ! local variables - TYPE ( f_ssids_fkeep_type ), POINTER :: ffkeep + TYPE ( f_slblt_fkeep_type ), POINTER :: ffkeep ! nothing to free IF ( .NOT. C_ASSOCIATED( cfkeep ) ) THEN - ssids_free_fkeep = 0 + slblt_free_fkeep = 0 RETURN END IF CALL C_F_POINTER( cfkeep, ffkeep ) - CALL f_ssids_free( ffkeep, ssids_free_fkeep ) + CALL f_slblt_free( ffkeep, slblt_free_fkeep ) DEALLOCATE( ffkeep ) cfkeep = C_NULL_PTR - END FUNCTION ssids_free_fkeep + END FUNCTION slblt_free_fkeep ! --------------------------------- -! C interface to fortran ssids_free +! C interface to fortran slblt_free ! --------------------------------- - INTEGER ( KIND = ipc_ ) FUNCTION ssids_free( cakeep, cfkeep ) BIND( C ) - USE GALAHAD_SSIDS_precision_ciface + INTEGER ( KIND = ipc_ ) FUNCTION slblt_free( cakeep, cfkeep ) BIND( C ) + USE GALAHAD_SLBLT_precision_ciface IMPLICIT NONE ! dummy arguments @@ -1016,50 +959,50 @@ INTEGER ( KIND = ipc_ ) FUNCTION ssids_free( cakeep, cfkeep ) BIND( C ) INTERFACE INTEGER ( KIND = ipc_ ) & - FUNCTION ssids_free_akeep( cakeep ) BIND( C ) + FUNCTION slblt_free_akeep( cakeep ) BIND( C ) USE iso_c_binding USE GALAHAD_KINDS_precision IMPLICIT NONE TYPE ( C_PTR ), INTENT( INOUT ) :: cakeep - END FUNCTION ssids_free_akeep + END FUNCTION slblt_free_akeep INTEGER ( KIND = ipc_ ) & - FUNCTION ssids_free_fkeep( cfkeep ) BIND( C ) + FUNCTION slblt_free_fkeep( cfkeep ) BIND( C ) USE iso_c_binding USE GALAHAD_KINDS_precision IMPLICIT NONE TYPE ( C_PTR ), INTENT( INOUT ) :: cfkeep - END FUNCTION ssids_free_fkeep + END FUNCTION slblt_free_fkeep END INTERFACE - ssids_free = ssids_free_akeep( cakeep ) - IF ( ssids_free /= 0_ipc_ ) RETURN - ssids_free = ssids_free_fkeep( cfkeep ) + slblt_free = slblt_free_akeep( cakeep ) + IF ( slblt_free /= 0_ipc_ ) RETURN + slblt_free = slblt_free_fkeep( cfkeep ) - END FUNCTION ssids_free + END FUNCTION slblt_free ! ------------------------------------------- -! C interface to fortran ssids_enquire_posdef +! C interface to fortran slblt_enquire_posdef ! ------------------------------------------- - SUBROUTINE ssids_enquire_posdef( cakeep, cfkeep, ccontrol, & + SUBROUTINE slblt_enquire_posdef( cakeep, cfkeep, ccontrol, & cinform, d ) BIND( C ) - USE GALAHAD_SSIDS_precision_ciface + USE GALAHAD_SLBLT_precision_ciface IMPLICIT NONE ! dummy arguments TYPE ( C_PTR ), VALUE :: cakeep TYPE ( C_PTR ), VALUE :: cfkeep - TYPE ( ssids_control_type ), INTENT( IN ) :: ccontrol - TYPE ( ssids_inform_type ), INTENT( OUT ) :: cinform + TYPE ( slblt_control_type ), INTENT( IN ) :: ccontrol + TYPE ( slblt_inform_type ), INTENT( OUT ) :: cinform REAL ( KIND = rpc_ ), DIMENSION( * ), INTENT( OUT ) :: d ! local variables - TYPE ( f_ssids_akeep_type ), POINTER :: fakeep - TYPE ( f_ssids_fkeep_type ), POINTER :: ffkeep - TYPE ( f_ssids_control_type ) :: fcontrol - TYPE ( f_ssids_inform_type ) :: finform + TYPE ( f_slblt_akeep_type ), POINTER :: fakeep + TYPE ( f_slblt_fkeep_type ), POINTER :: ffkeep + TYPE ( f_slblt_control_type ) :: fcontrol + TYPE ( f_slblt_inform_type ) :: finform LOGICAL :: cindexed @@ -1082,38 +1025,38 @@ SUBROUTINE ssids_enquire_posdef( cakeep, cfkeep, ccontrol, & ! call fortran routine - CALL f_ssids_enquire_posdef( fakeep, ffkeep, fcontrol, finform, d ) + CALL f_slblt_enquire_posdef( fakeep, ffkeep, fcontrol, finform, d ) ! copy arguments out CALL copy_inform_out( finform, cinform ) - END SUBROUTINE ssids_enquire_posdef + END SUBROUTINE slblt_enquire_posdef ! ------------------------------------------ -! C interface to fortran ssids_enquire_indef +! C interface to fortran slblt_enquire_indef ! ------------------------------------------ - SUBROUTINE ssids_enquire_indef( cakeep, cfkeep, ccontrol, cinform, & + SUBROUTINE slblt_enquire_indef( cakeep, cfkeep, ccontrol, cinform, & cpiv_order, cd ) BIND( C ) - USE GALAHAD_SSIDS_precision_ciface + USE GALAHAD_SLBLT_precision_ciface IMPLICIT NONE ! dummy arguments TYPE ( C_PTR ), VALUE :: cakeep TYPE ( C_PTR ), VALUE :: cfkeep - TYPE ( ssids_control_type ), INTENT( IN ) :: ccontrol - TYPE ( ssids_inform_type ), INTENT( OUT ) :: cinform + TYPE ( slblt_control_type ), INTENT( IN ) :: ccontrol + TYPE ( slblt_inform_type ), INTENT( OUT ) :: cinform TYPE ( C_PTR ), VALUE :: cpiv_order TYPE ( C_PTR ), VALUE :: cd ! local variables - TYPE ( f_ssids_akeep_type ), POINTER :: fakeep - TYPE ( f_ssids_fkeep_type ), POINTER :: ffkeep - TYPE ( f_ssids_control_type ) :: fcontrol - TYPE ( f_ssids_inform_type ) :: finform + TYPE ( f_slblt_akeep_type ), POINTER :: fakeep + TYPE ( f_slblt_fkeep_type ), POINTER :: ffkeep + TYPE ( f_slblt_control_type ) :: fcontrol + TYPE ( f_slblt_inform_type ) :: finform INTEGER ( KIND = ipc_ ), DIMENSION( : ), POINTER :: fpiv_order REAL ( KIND = rpc_ ), DIMENSION( :,: ), POINTER :: fd @@ -1150,17 +1093,17 @@ SUBROUTINE ssids_enquire_indef( cakeep, cfkeep, ccontrol, cinform, & IF ( ASSOCIATED( fpiv_order ) ) THEN IF ( ASSOCIATED( fd ) ) THEN - CALL f_ssids_enquire_indef( fakeep, ffkeep, fcontrol, finform, & + CALL f_slblt_enquire_indef( fakeep, ffkeep, fcontrol, finform, & piv_order = fpiv_order, d = fd ) ELSE - CALL f_ssids_enquire_indef( fakeep, ffkeep, fcontrol, finform, & + CALL f_slblt_enquire_indef( fakeep, ffkeep, fcontrol, finform, & piv_order=fpiv_order ) END IF ELSE IF ( ASSOCIATED( fd ) ) THEN - CALL f_ssids_enquire_indef( fakeep, ffkeep, fcontrol, finform, d = fd ) + CALL f_slblt_enquire_indef( fakeep, ffkeep, fcontrol, finform, d = fd ) ELSE - CALL f_ssids_enquire_indef( fakeep, ffkeep, fcontrol, finform ) + CALL f_slblt_enquire_indef( fakeep, ffkeep, fcontrol, finform ) END IF END IF @@ -1172,14 +1115,14 @@ SUBROUTINE ssids_enquire_indef( cakeep, cfkeep, ccontrol, cinform, & fpiv_order( : ) = ABS( fpiv_order( : ) ) - 1 CALL copy_inform_out( finform, cinform ) - END SUBROUTINE ssids_enquire_indef + END SUBROUTINE slblt_enquire_indef ! ---------------------------------- -! C interface to fortran ssids_alter +! C interface to fortran slblt_alter ! ---------------------------------- - SUBROUTINE ssids_alter( d, cakeep, cfkeep, ccontrol, cinform ) BIND( C ) - USE GALAHAD_SSIDS_precision_ciface + SUBROUTINE slblt_alter( d, cakeep, cfkeep, ccontrol, cinform ) BIND( C ) + USE GALAHAD_SLBLT_precision_ciface IMPLICIT NONE ! dummy arguments @@ -1187,15 +1130,15 @@ SUBROUTINE ssids_alter( d, cakeep, cfkeep, ccontrol, cinform ) BIND( C ) REAL ( KIND = rpc_ ), DIMENSION( 2, * ), INTENT( IN ) :: d TYPE ( C_PTR ), VALUE :: cakeep TYPE ( C_PTR ), VALUE :: cfkeep - TYPE ( ssids_control_type ), INTENT( IN ) :: ccontrol - TYPE ( ssids_inform_type ), INTENT( OUT ) :: cinform + TYPE ( slblt_control_type ), INTENT( IN ) :: ccontrol + TYPE ( slblt_inform_type ), INTENT( OUT ) :: cinform ! local variables - TYPE ( f_ssids_akeep_type ), POINTER :: fakeep - TYPE ( f_ssids_fkeep_type ), POINTER :: ffkeep - TYPE ( f_ssids_control_type ) :: fcontrol - TYPE ( f_ssids_inform_type ) :: finform + TYPE ( f_slblt_akeep_type ), POINTER :: fakeep + TYPE ( f_slblt_fkeep_type ), POINTER :: ffkeep + TYPE ( f_slblt_control_type ) :: fcontrol + TYPE ( f_slblt_inform_type ) :: finform LOGICAL :: cindexed @@ -1218,10 +1161,10 @@ SUBROUTINE ssids_alter( d, cakeep, cfkeep, ccontrol, cinform ) BIND( C ) ! call fortran routine - CALL f_ssids_alter( d, fakeep, ffkeep, fcontrol, finform ) + CALL f_slblt_alter( d, fakeep, ffkeep, fcontrol, finform ) ! copy arguments out CALL copy_inform_out( finform, cinform ) - END SUBROUTINE ssids_alter + END SUBROUTINE slblt_alter diff --git a/src/ssids/C/ssidst.c b/src/slblt/C/slbltt.c similarity index 72% rename from src/ssids/C/ssidst.c rename to src/slblt/C/slbltt.c index ebadd4bff2..00a64e0468 100644 --- a/src/ssids/C/ssidst.c +++ b/src/slblt/C/slbltt.c @@ -1,4 +1,4 @@ -/* ssidst.c - Example code for GALAHAD_SSIDS package, GALified by */ +/* slbltt.c - Example code for GALAHAD_SLBLT package, GALified by */ /* Jari Fowkes, Nick Gould, STFC-Rutherford Appleton Laboratory, */ /* and Alexis Montoison, Argone National Laboratory, 2025-08-19 */ #include @@ -7,7 +7,7 @@ #include #include "galahad_precision.h" #include "galahad_cfunctions.h" -#include "galahad_ssids.h" +#include "galahad_slblt.h" #ifdef REAL_128 #include #endif @@ -15,12 +15,12 @@ int main(void) { /* Derived types */ void *akeep, *fkeep; - struct ssids_control_type control; - struct ssids_inform_type inform; + struct slblt_control_type control; + struct slblt_inform_type inform; // Initialize derived types akeep = NULL; fkeep = NULL; // Important that these are NULL to start with - ssids_default_control(&control); + slblt_default_control(&control); control.array_base = 0; // C sparse matrix indexing printf(" C sparse matrix indexing\n\n"); @@ -42,22 +42,22 @@ int main(void) { // perform analysis and factorization with data checking bool check = true; - ssids_analyse(check, n, NULL, ptr, row, NULL, &akeep, &control, &inform); + slblt_analyse(check, n, NULL, ptr, row, NULL, &akeep, &control, &inform); if(inform.flag<0) { - ssids_free(&akeep, &fkeep); + slblt_free(&akeep, &fkeep); exit(1); } - ssids_factor(posdef, NULL, NULL, val, NULL, akeep, &fkeep, &control, + slblt_factor(posdef, NULL, NULL, val, NULL, akeep, &fkeep, &control, &inform); if(inform.flag<0) { - ssids_free( &akeep, &fkeep ); + slblt_free( &akeep, &fkeep ); exit(1); } // solve - ssids_solve1(0, x, akeep, fkeep, &control, &inform); + slblt_solve1(0, x, akeep, fkeep, &control, &inform); if(inform.flag<0) { - ssids_free(&akeep, &fkeep); + slblt_free(&akeep, &fkeep); exit(1); } printf("The computed solution is:"); @@ -66,13 +66,13 @@ int main(void) { /* Determine and print the pivot order */ ipc_ piv_order[5]; - ssids_enquire_indef(akeep, fkeep, &control, &inform, piv_order, NULL); + slblt_enquire_indef(akeep, fkeep, &control, &inform, piv_order, NULL); printf("Pivot order:"); for(int i=0; i @@ -7,7 +7,7 @@ #include #include "galahad_precision.h" #include "galahad_cfunctions.h" -#include "galahad_ssids.h" +#include "galahad_slblt.h" #ifdef REAL_128 #include #endif @@ -15,12 +15,12 @@ int main(void) { /* Derived types */ void *akeep, *fkeep; - struct ssids_control_type control; - struct ssids_inform_type inform; + struct slblt_control_type control; + struct slblt_inform_type inform; // Initialize derived types akeep = NULL; fkeep = NULL; // Important that these are NULL to start with - ssids_default_control(&control); + slblt_default_control(&control); control.array_base = 1; // Fortran sparse matrix indexing control.nodend_control.print_level = 0; @@ -43,22 +43,22 @@ int main(void) { // perform analysis and factorization with data checking bool check = true; - ssids_analyse(check, n, NULL, ptr, row, NULL, &akeep, &control, &inform); + slblt_analyse(check, n, NULL, ptr, row, NULL, &akeep, &control, &inform); if(inform.flag<0) { - ssids_free(&akeep, &fkeep); + slblt_free(&akeep, &fkeep); exit(1); } - ssids_factor(posdef, NULL, NULL, val, NULL, akeep, &fkeep, &control, + slblt_factor(posdef, NULL, NULL, val, NULL, akeep, &fkeep, &control, &inform); if(inform.flag<0) { - ssids_free( &akeep, &fkeep ); + slblt_free( &akeep, &fkeep ); exit(1); } // solve - ssids_solve1(0, x, akeep, fkeep, &control, &inform); + slblt_solve1(0, x, akeep, fkeep, &control, &inform); if(inform.flag<0) { - ssids_free(&akeep, &fkeep); + slblt_free(&akeep, &fkeep); exit(1); } printf("The computed solution is:"); @@ -67,13 +67,13 @@ int main(void) { /* Determine and print the pivot order */ ipc_ piv_order[5]; - ssids_enquire_indef(akeep, fkeep, &control, &inform, piv_order, NULL); + slblt_enquire_indef(akeep, fkeep, &control, &inform, piv_order, NULL); printf("Pivot order:"); for(int i=0; i ../slblt/slblts.output 2>&1 + cat ../slblt/slblts.output + rm ../slblt/run_slblt + +slbltds: $(SLBLTDS) + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt $(RSLBLTDS) +# - ../slblt/run_slblt < ../slblt/slblts.data + - ../slblt/run_slblt < ../slblt/slblts.data \ + > ../slblt/slbltds.output 2>&1 + cat ../slblt/slbltds.output + rm ../slblt/run_slblt + +slbltqs: $(SLBLTQS) + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt $(RSLBLTQS) +# - ../slblt/run_slblt < ../slblt/slblts.data + - ../slblt/run_slblt < ../slblt/slblts.data \ + > ../slblt/slbltds.output 2>&1 + cat ../slblt/slbltds.output + rm ../slblt/run_slblt + +slbltds_valgrind: $(SLBLTDS) + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt $(RSLBLTDS) + - valgrind $(VALGRIND) ../slblt/run_slblt < ../slblt/slblts.data + rm ../slblt/run_slblt + +slbltss_64: $(SLBLTSS64) + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt $(RSLBLTSS64) +# - ../slblt/run_slblt < ../slblt/slblts.data + - ../slblt/run_slblt < ../slblt/slblts.data \ + > ../slblt/slblts_64.output 2>&1 + cat ../slblt/slblts_64.output + rm ../slblt/run_slblt + +slbltds_64: $(SLBLTDS64) + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt $(RSLBLTDS64) +# - ../slblt/run_slblt < ../slblt/slblts.data + - ../slblt/run_slblt < ../slblt/slblts.data \ + > ../slblt/slbltds_64.output 2>&1 + cat ../slblt/slbltds_64.output + rm ../slblt/run_slblt + +slbltqs_64: $(SLBLTDQ64) + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt $(RSLBLTDQ64) + - ../slblt/run_slblt < ../slblt/slblts.data \ + > ../slblt/slbltds_64.output 2>&1 + cat ../slblt/slbltds_64.output + rm ../slblt/run_slblt + +slbltds_64_valgrind: $(SLBLTDS64) + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt $(RSLBLTDS64) + - valgrind $(VALGRIND) ../slblt/run_slblt < ../slblt/slblts.data + rm ../slblt/run_slblt + +# run full tests + +slbltst: $(SLBLTST) + echo " Exhaustive test of subroutine interface to slblt" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt $(RSLBLTST) +# - ../slblt/run_slblt < ../slblt/slblts.data + - ../slblt/run_slblt > ../slblt/slbltt.output 2>&1 + cat ../slblt/slbltt.output + rm ../slblt/run_slblt + +slbltst2: $(SLBLTST2) + echo " Exhaustive test of subroutine interface to slblt" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt2 $(RSLBLTST2) +# - ../slblt/run_slblt2 + - ../slblt/run_slblt2 > ../slblt/slbltt2.output 2>&1 + cat ../slblt/slbltt2.output + rm ../slblt/run_slblt2 + +slbltdt: $(SLBLTDT) + echo " Exhaustive test of subroutine interface to slblt" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt $(RSLBLTDT) +# - ../slblt/run_slblt + - ../slblt/run_slblt > ../slblt/slbltdt.output 2>&1 + cat ../slblt/slbltdt.output +# rm ../slblt/run_slblt + +slbltdt2: $(SLBLTDT2) + echo " Exhaustive test of subroutine interface to slblt" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt2 $(RSLBLTDT2) +# - ../slblt/run_slblt2 + - ../slblt/run_slblt2 > ../slblt/slbltdt2.output 2>&1 + cat ../slblt/slbltdt2.output + rm ../slblt/run_slblt2 + +slbltqt: $(SLBLTQT) + echo " Exhaustive test of subroutine interface to slblt" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt $(RSLBLTQT) +# - ../slblt/run_slblt + - ../slblt/run_slblt > ../slblt/slbltqt.output 2>&1 + cat ../slblt/slbltqt.output + rm ../slblt/run_slblt + +slbltqt2: $(SLBLTQT2) + echo " Exhaustive test of subroutine interface to slblt" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt2 $(RSLBLTQT2) +# - ../slblt/run_slblt2 + - ../slblt/run_slblt2 > ../slblt/slbltqt2.output 2>&1 + cat ../slblt/slbltqt2.output + rm ../slblt/run_slblt + +slbltst_64: $(SLBLTST64) + echo " Exhaustive test of subroutine interface to slblt" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt $(RSLBLTST64) +# - ../slblt/run_slblt < ../slblt/slblts.data + - ../slblt/run_slblt > ../slblt/slbltt_64.output 2>&1 + cat ../slblt/slbltt_64.output + rm ../slblt/run_slblt + +slbltst2_64: $(SLBLTST264) + echo " Exhaustive test of subroutine interface to slblt" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt2 $(RSLBLTST264) +# - ../slblt/run_slblt2 < ../slblt/slblts.data + - ../slblt/run_slblt2 > ../slblt/slbltt2_64.output 2>&1 + cat ../slblt/slbltt2_64.output + rm ../slblt/run_slblt2 + +slbltdt_64: $(SLBLTDT64) + echo " Exhaustive test of subroutine interface to slblt" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt $(RSLBLTDT64) +# - ../slblt/run_slblt + - ../slblt/run_slblt > ../slblt/slbltdt_64.output 2>&1 + cat ../slblt/slbltdt_64.output + rm ../slblt/run_slblt + +slbltdt2_64: $(SLBLTDT264) + echo " Exhaustive test of subroutine interface to slblt" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt2 $(RSLBLTDT264) +# - ../slblt/run_slblt2 + - ../slblt/run_slblt2 > ../slblt/slbltdt2_64.output 2>&1 + cat ../slblt/slbltdt2_64.output + rm ../slblt/run_slblt2 + +slbltqt_64: $(SLBLTQT64) + echo " Exhaustive test of subroutine interface to slblt" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt $(RSLBLTQT64) +# - ../slblt/run_slblt + - ../slblt/run_slblt > ../slblt/slbltdt_64.output 2>&1 + cat ../slblt/slbltdt_64.output + rm ../slblt/run_slblt + +slbltqt2_64: $(SLBLTQT264) + echo " Exhaustive test of subroutine interface to slblt" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt2 $(RSLBLTQT264) +# - ../slblt/run_slblt2 + - ../slblt/run_slblt2 > ../slblt/slbltdt2_64.output 2>&1 + cat ../slblt/slbltdt2_64.output + rm ../slblt/run_slblt2 + +slbltdt_gdb: $(SLBLTDT) + echo " Exhaustive test of subroutine interface to slblt" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt $(RSLBLTDT) + - gdb $(GDB) ./run_slblt + rm ../slblt/run_slblt + +slbltdt_valgrind: $(SLBLTDT) + echo " Exhaustive test of subroutine interface to slblt" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt $(RSLBLTDT) +# - ../slblt/run_slblt + - valgrind $(VALGRIND) ../slblt/run_slblt + rm ../slblt/run_slblt + +# run debugging tests + +slbltdt_64_gdb: $(SLBLTDT64) + echo " Exhaustive test of subroutine interface to slblt" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt $(RSLBLTDT64) + - gdb $(GDB) ./run_slblt + rm ../slblt/run_slblt + +slbltdt_64_valgrind: $(SLBLTDT64) + echo " Exhaustive test of subroutine interface to slblt" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt $(RSLBLTDT64) +# - ../slblt/run_slblt + - valgrind $(VALGRIND) ../slblt/run_slblt + rm ../slblt/run_slblt + +# run full (comprehensive) C example tests + +slbltcst: $(SLBLTCST) + echo "" + echo " Exhaustive test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCST) + - ./run_slblt > slbltcst.output 2>&1 + cat slbltcst.output + rm ./run_slblt + +slbltcstf: $(SLBLTCSTF) + echo "" + echo " Exhaustive test of Fortran function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCSTF) + - ./run_slblt > slbltcstf.output 2>&1 + cat slbltcstf.output + rm ./run_slblt + +slbltcdt: $(SLBLTCDT) + echo "" + echo " Exhaustive test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCDT) + - ./run_slblt > slbltdt.output 2>&1 + cat slbltdt.output + rm ./run_slblt + +slbltcdtf: $(SLBLTCDTF) + echo "" + echo " Exhaustive test of Fortran function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCDTF) + - ./run_slblt +# - ./run_slblt > slbltdtf.output 2>&1 +# cat slbltdtf.output + rm ./run_slblt + +slbltcqt: $(SLBLTCQT) + echo "" + echo " Exhaustive test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCQT) + - ./run_slblt > slbltcqt.output 2>&1 + cat slbltcqt.output + rm ./run_slblt + +slbltcqtf: $(SLBLTCQTF) + echo "" + echo " Exhaustive test of Fortran function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCQTF) + - ./run_slblt > slbltcqtf.output 2>&1 + cat slbltcqtf.output + rm ./run_slblt + +slbltcst_64: $(SLBLTCST64) + echo "" + echo " Exhaustive test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCST64) + - ./run_slblt > slbltcst64.output 2>&1 + cat slbltcst64.output + rm ./run_slblt + +slbltcstf_64: $(SLBLTCSTF64) + echo "" + echo " Exhaustive test of Fortran function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCSTF64) + - ./run_slblt > slbltcstf64.output 2>&1 + cat slbltcstf64.output + rm ./run_slblt + +slbltcdt_64: $(SLBLTCDT64) + echo "" + echo " Exhaustive test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCDT64) + - ./run_slblt > slbltcdt64.output 2>&1 + cat slbltcdt64.output + rm ./run_slblt + +slbltcdtf_64: $(SLBLTCDTF64) + echo "" + echo " Exhaustive test of Fortran function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCDTF64) + - ./run_slblt > slbltcdtf64.output 2>&1 + cat slbltcdtf64.output + rm ./run_slblt + +slbltcqt_64: $(SLBLTCQT64) + echo "" + echo " Exhaustive test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCQT64) + - ./run_slblt > slbltcqt64.output 2>&1 + cat slbltcqt64.output + rm ./run_slblt + +slbltcqtf_64: $(SLBLTCQTF64) + echo "" + echo " Exhaustive test of Fortran function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCQTF64) + - ./run_slblt > slbltcqtf64.output 2>&1 + cat slbltcqtf64.output + rm ./run_slblt + +# run debugging C example tests + +slbltcst_valgrind: $(SLBLTCST) + echo "" + echo " Exhaustive valgrind test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCST) + - valgrind $(VALGRIND) ./run_slblt > \ + slbltcst_valgrind.output 2>&1 + cat slbltcst_valgrind.output + rm ./run_slblt + +slbltcstf_valgrind: $(SLBLTCSTF) + echo "" + echo " Exhaustive valgrind test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCSTF) + - valgrind $(VALGRIND) ./run_slblt > \ + slbltcstf_valgrind.output 2>&1 + cat slbltcstf_valgrind.output + rm ./run_slblt + +slbltcst_gdb: $(SLBLTCST) + echo "" + echo " Exhaustive gdb test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCST) + - gdb $(GDB) ./run_slblt + rm ./run_slblt + +slbltcdt_valgrind: $(SLBLTCDT) + echo "" + echo " Exhaustive valgrind test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCDT) + - ./run_slblt > slbltdt.output 2>&1 + - valgrind $(VALGRIND) ./run_slblt > \ + slbltdt_valgrind.output 2>&1 + cat slbltdt_valgrind.output + rm ./run_slblt + +slbltcdt_gdb: $(SLBLTCDT) + echo "" + echo " Exhaustive gdb test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCDT) + $(RMOOC) + - gdb $(GDB) ./run_slblt + rm ./run_slblt + +slbltcqt_valgrind: $(SLBLTCQT) + echo "" + echo " Exhaustive valgrind test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCQT) + - valgrind $(VALGRIND) ./run_slblt > \ + slbltcqt_valgrind.output 2>&1 + cat slbltcqt_valgrind.output + rm ./run_slblt + +slbltcqt_gdb: $(SLBLTCQT) + echo "" + echo " Exhaustive gdb test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCQT) + - gdb $(GDB) ./run_slblt + rm ./run_slblt + +slbltcst_64_valgrind: $(SLBLTCST64) + echo "" + echo " Exhaustive valgrind test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCST64) + - valgrind $(VALGRIND) ./run_slblt > \ + slbltcst64_valgrind.output 2>&1 + cat slbltcst64_valgrind.output + rm ./run_slblt + +slbltcstf_64_valgrind: $(SLBLTCSTF64) + echo "" + echo " Exhaustive valgrind test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCSTF64) + - valgrind $(VALGRIND) ./run_slblt > \ + slbltcstf64_valgrind.output 2>&1 + cat slbltcstf64_valgrind.output + rm ./run_slblt + +slbltcst_64_gdb: $(SLBLTCST64) + echo "" + echo " Exhaustive gdb test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCST64) + - gdb $(GDB) ./run_slblt + rm ./run_slblt + +slbltcdt_64_gdb: $(SLBLTCDT64) + echo "" + echo " Exhaustive gdb test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCDT64) + - gdb $(GDB) ./run_slblt + rm ./run_slblt + +slbltcqt_64_gdb: $(SLBLTCQT64) + echo "" + echo " Exhaustive gdb test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCQT64) + - gdb $(GDB) ./run_slblt + rm ./run_slblt + +slbltcqtf_64_valgrind: $(SLBLTCQTF64) + echo "" + echo " Exhaustive valgrind test of C function interface to slblt" + $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + $(NOFMAIN) -o run_slblt $(RSLBLTCQTF64) + - valgrind $(VALGRIND) ./run_slblt > \ + slbltcqtf64_valgrind.output 2>&1 + cat slbltcqtf64_valgrind.output + rm ./run_slblt + +# basic packages + +basics: + ( cd ../general ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ + basic_silent PRECIS=$(PRECIS) PWD=$(PWD)/../general ) +topology: + ( cd ../topology ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ + topology_silent PRECIS=$(PRECIS) PWD=$(PWD)/../topology ) +mo: + ( cd ../mo ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ + mo_silent PRECIS=$(PRECIS) PWD=$(PWD)/../mo ) +ms: + ( cd ../ms ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ + ms_silent PRECIS=$(PRECIS) PWD=$(PWD)/../ms ) +mu: + ( cd ../mu ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ + mu_silent PRECIS=$(PRECIS) PWD=$(PWD)/../mu ) +rb: + ( cd ../rb ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ + rb_silent PRECIS=$(PRECIS) PWD=$(PWD)/../rb ) +nodend_c: + ( cd ../nodend ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ + nodend_ciface_silent PRECIS=$(PRECIS) PWD=$(PWD)/../nodend ) + +# individual compilations + +types.o: $(RLG)(types_$(PRECIS).o) + +$(RLG)(types_$(PRECIS).o): ../slblt/types.F90 + @printf ' %-9s %-15s\t\t' "Compiling" "types " + $(CP) ../slblt/types.F90 $(OBJ)/types.F90 + cd $(OBJ) ; $(FORTRAN) -o types_$(PRECIS).o \ + $(FFLAGSOMP) types.F90 \ + || ( printf ' %-26s' "=> Disabling optimization " ; \ + $(FORTRAN) -o types_$(PRECIS).o \ + $(FFLAGSNOMP) types.F90 ) + cd $(OBJ) ; $(RARR) types_$(PRECIS).o ; \ + $(RM) types.F90 types_$(PRECIS).o + $(RRMARFILE) numeric_subtree_$(PRECIS).o + $(MVMODS) + @printf '[ OK ]\n' + +subtree.o: $(RLG)(subtree_$(PRECIS).o) + +$(RLG)(subtree_$(PRECIS).o): ../slblt/subtree.F90 + @printf ' %-9s %-15s\t\t' "Compiling" "subtree " + $(CP) ../slblt/subtree.F90 $(OBJ)/subtree.F90 + cd $(OBJ) ; $(FORTRAN) -o subtree_$(PRECIS).o \ + $(FFLAGSOMP) subtree.F90 \ + || ( printf ' %-26s' "=> Disabling optimization " ; \ + $(FORTRAN) -o subtree_$(PRECIS).o \ + $(FFLAGSNOMP) subtree.F90 ) + cd $(OBJ) ; $(RARR) subtree_$(PRECIS).o ; \ + $(RM) subtree.F90 subtree_$(PRECIS).o + $(RRMARFILE) numeric_subtree_$(PRECIS).o + $(RRMARFILE) akeep_$(PRECIS).o + $(MVMODS) + @printf '[ OK ]\n' + +akeep.o: $(RLG)(akeep_$(PRECIS).o) + +$(RLG)(akeep_$(PRECIS).o): ../slblt/akeep.F90 + @printf ' %-9s %-15s\t\t' "Compiling" "akeep " + $(CP) ../slblt/akeep.F90 $(OBJ)/akeep.F90 + cd $(OBJ) ; $(FORTRAN) -o akeep_$(PRECIS).o $(FFLAGSOMP) akeep.F90 \ + || ( printf ' %-26s' "=> Disabling optimization " ; \ + $(FORTRAN) -o akeep_$(PRECIS).o $(FFLAGSNOMP) akeep.F90 ) + cd $(OBJ) ; $(RARR) akeep_$(PRECIS).o ; \ + $(RM) akeep.F90 akeep_$(PRECIS).o + $(RRMARFILE) slblt_$(PRECIS).o + $(MVMODS) + @printf '[ OK ]\n' + +slblt_factor.o: $(RLG)(slblt_factor_$(PRECIS).o) + +$(RLG)(slblt_factor_$(PRECIS).o): ../slblt/slblt_factor.F90 + @printf ' %-9s %-15s\t\t' "Compiling" "slblt_factor " + $(CP) ../slblt/slblt_factor.F90 $(OBJ)/slblt_factor.F90 + cd $(OBJ) ; $(FORTRAN) -o slblt_factor_$(PRECIS).o \ + $(FFLAGSOMP) slblt_factor.F90 \ + || ( printf ' %-26s' "=> Disabling optimization " ; \ + $(FORTRAN) -o slblt_factor_$(PRECIS).o \ + $(FFLAGSNOMP) slblt_factor.F90 ) + cd $(OBJ) ; $(RARR) slblt_factor_$(PRECIS).o ; \ + $(RM) slblt_factor.F90 slblt_factor_$(PRECIS).o + $(RRMARFILE) numeric_subtree_$(PRECIS).o + $(MVMODS) + @printf '[ OK ]\n' + +numeric_subtree.o: $(RLG)(numeric_subtree_$(PRECIS).o) + +$(RLG)(numeric_subtree_$(PRECIS).o): ../slblt/numeric_subtree.F90 + @printf ' %-9s %-15s\t\t' "Compiling" "numeric_subtree " + $(CP) ../slblt/numeric_subtree.F90 $(OBJ)/numeric_subtree.F90 + cd $(OBJ) ; $(FORTRAN) -o numeric_subtree_$(PRECIS).o \ + $(FFLAGSOMP) numeric_subtree.F90 \ + || ( printf ' %-26s' "=> Disabling optimization " ; \ + $(FORTRAN) -o numeric_subtree_$(PRECIS).o \ + $(FFLAGSNOMP) numeric_subtree.F90 ) + cd $(OBJ) ; $(RARR) numeric_subtree_$(PRECIS).o ; \ + $(RM) numeric_subtree.F90 numeric_subtree_$(PRECIS).o + $(RRMARFILE) slblt_$(PRECIS).o + $(MVMODS) + @printf '[ OK ]\n' + +contrib_iface.o: $(RLG)(contrib_iface_$(PRECIS).o) + +$(RLG)(contrib_iface_$(PRECIS).o): ../slblt/contrib_iface.F90 + @printf ' %-9s %-15s\t\t' "Compiling" "contrib_iface " + $(CP) ../slblt/contrib_iface.F90 $(OBJ)/contrib_iface.F90 + cd $(OBJ) ; $(FORTRAN) -o contrib_iface_$(PRECIS).o $(FFLAGSOMP) \ + contrib_iface.F90 \ + || ( printf ' %-26s' "=> Disabling optimization " ; \ + $(FORTRAN) -o contrib_iface_$(PRECIS).o $(FFLAGSNOMP) \ + contrib_iface.F90 ) + cd $(OBJ) ; $(RARR) contrib_iface_$(PRECIS).o ; \ + $(RM) contrib_iface.F90 contrib_iface_$(PRECIS).o +# $(MVMODS) + @printf '[ OK ]\n' + +slblt.o: $(RLG)(slblt_$(PRECIS).o) + +$(RLG)(slblt_$(PRECIS).o): ../slblt/slblt.F90 + @printf ' %-9s %-15s\t\t' "Compiling" "slblt " + $(CP) ../slblt/slblt.F90 $(OBJ)/slblt.F90 + cd $(OBJ) ; $(FORTRAN) -o slblt_$(PRECIS).o $(FFLAGSOMP) slblt.F90 \ + || ( printf ' %-26s' "=> Disabling optimization " ; \ + $(FORTRAN) -o slblt_$(PRECIS).o $(FFLAGSNOMP) slblt.F90 ) + cd $(OBJ) ; $(RARR) slblt_$(PRECIS).o ; \ + $(RM) slblt.F90 slblt_$(PRECIS).o + $(RMARFILE) sls_$(PRECIS).o + $(MVMODS) + @printf '[ OK ]\n' + +# C interface + +slblt_ciface.o: $(CLG)(slblt_ciface_$(PRECIS).o) + +$(CLG)(slblt_ciface_$(PRECIS).o): ../slblt/C/slblt_ciface.F90 + @printf ' %-9s %-15s\t\t' "Compiling" "slblt_ciface" + $(CP) ../slblt/C/slblt_ciface.F90 $(OBJ)/slblt_ciface.F90 + cd $(OBJ) ; $(FORTRAN) -o slblt_ciface_$(PRECIS).o $(FFLAGSOMP) \ + slblt_ciface.F90 + cd $(OBJ) ; $(CARR) slblt_ciface_$(PRECIS).o ; \ + $(RM) slblt_ciface.F90 slblt_ciface_$(PRECIS).o + $(CRMARFILE) sls_ciface_$(PRECIS).o + $(MVMODS) + @printf '[ OK ]\n' + +# test programs + +slblts.o: $(OBJ)/slblts_$(PRECIS).o + +$(OBJ)/slblts_$(PRECIS).o: ../slblt/slblts.f90 + @printf ' %-9s %-15s\t\t' "Compiling" "slblts " + $(SED) -f $(SEDS) ../slblt/slblts.f90 > $(OBJ)/slblts.f90 + cd $(OBJ) ; $(FORTRAN) -o slblts_$(PRECIS).o $(FFLAGSOMP) slblts.f90 + rm $(OBJ)/*.f90 + @printf '[ OK ]\n' + +slbltt.o: $(OBJ)/slbltt_$(PRECIS).o + +$(OBJ)/slbltt_$(PRECIS).o: ../slblt/slbltt.F90 + @printf ' %-9s %-15s\t\t' "Compiling" "slbltt " + $(CP) ../slblt/slbltt.F90 $(OBJ)/slbltt.F90 + cd $(OBJ) ; $(FORTRAN) -o slbltt_$(PRECIS).o $(FFLAGSS) slbltt.F90 + rm $(OBJ)/*.F90 + @printf '[ OK ]\n' + +slblt_factort.o: $(OBJ)/slblt_factort_$(PRECIS).o + +$(OBJ)/slblt_factort_$(PRECIS).o: ../slblt/slblt_factort.F90 + @printf ' %-9s %-15s\t\t' "Compiling" "slblt_factort " + $(CP) ../slblt/slblt_factort.F90 $(OBJ)/slblt_factort.F90 + cd $(OBJ) ; $(FORTRAN) -o slblt_factort_$(PRECIS).o $(FFLAGSS) slblt_factort.F90 + rm $(OBJ)/*.F90 + @printf '[ OK ]\n' + +slblt_factort: slblt_factort_$(PRECIS) + +slblt_factort_single: $(SLBLTFTS) + echo " Unit tests of the SLBLT Fortran factor kernels" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt_factort $(RSLBLTFTS) + - ../slblt/run_slblt_factort > ../slblt/slblt_factort_single.output 2>&1 + cat ../slblt/slblt_factort_single.output + rm ../slblt/run_slblt_factort + +slblt_factort_double: $(SLBLTFTD) + echo " Unit tests of the SLBLT Fortran factor kernels" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt_factort $(RSLBLTFTD) + - ../slblt/run_slblt_factort > ../slblt/slblt_factort_double.output 2>&1 + cat ../slblt/slblt_factort_double.output + rm ../slblt/run_slblt_factort + +slblt_factort_quadruple: $(SLBLTFTQ) + echo " Unit tests of the SLBLT Fortran factor kernels" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt_factort $(RSLBLTFTQ) + - ../slblt/run_slblt_factort > ../slblt/slblt_factort_quadruple.output 2>&1 + cat ../slblt/slblt_factort_quadruple.output + rm ../slblt/run_slblt_factort + +slblt_factort_single_64: $(SLBLTFTS64) + echo " Unit tests of the SLBLT Fortran factor kernels" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt_factort $(RSLBLTFTS64) + - ../slblt/run_slblt_factort > ../slblt/slblt_factort_single_64.output 2>&1 + cat ../slblt/slblt_factort_single_64.output + rm ../slblt/run_slblt_factort + +slblt_factort_double_64: $(SLBLTFTD64) + echo " Unit tests of the SLBLT Fortran factor kernels" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt_factort $(RSLBLTFTD64) + - ../slblt/run_slblt_factort > ../slblt/slblt_factort_double_64.output 2>&1 + cat ../slblt/slblt_factort_double_64.output + rm ../slblt/run_slblt_factort + +slblt_factort_quadruple_64: $(SLBLTFTQ64) + echo " Unit tests of the SLBLT Fortran factor kernels" + cd ../slblt ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ + -o run_slblt_factort $(RSLBLTFTQ64) + - ../slblt/run_slblt_factort > ../slblt/slblt_factort_quadruple_64.output 2>&1 + cat ../slblt/slblt_factort_quadruple_64.output + rm ../slblt/run_slblt_factort + + +slbltt2.o: $(OBJ)/slbltt2_$(PRECIS).o + +$(OBJ)/slbltt2_$(PRECIS).o: ../slblt/slbltt2.F90 + @printf ' %-9s %-15s\t\t' "Compiling" "slbltt2 " + $(CP) ../slblt/slbltt2.F90 $(OBJ)/slbltt2.F90 + cd $(OBJ) ; $(FORTRAN) -o slbltt2_$(PRECIS).o $(FFLAGSS) slbltt2.F90 + rm $(OBJ)/*.F90 + @printf '[ OK ]\n' + +# test programs for C programs + +slbltct.o: $(OBJ)/slbltct_$(PRECIS).o + +$(OBJ)/slbltct_$(PRECIS).o: ../slblt/C/slbltt.c + @printf ' %-9s %-15s\t\t' "Compiling" "slbltct " + $(CP) ../slblt/C/slbltt.c $(OBJ)/slbltct.c + cd $(OBJ) ; $(CC) -o slbltct_$(PRECIS).o $(CFLAGS) \ + slbltct.c -I $(GALAHAD)/include -I $(OBJ) + rm $(OBJ)/*.c + @printf '[ OK ]\n' + +slbltctf.o: $(OBJ)/slbltctf_$(PRECIS).o + +$(OBJ)/slbltctf_$(PRECIS).o: ../slblt/C/slblttf.c + @printf ' %-9s %-15s\t\t' "Compiling" "slbltctf " + $(CP) ../slblt/C/slblttf.c $(OBJ)/slbltctf.c + cd $(OBJ) ; $(CC) -o slbltctf_$(PRECIS).o $(CFLAGS) \ + slbltctf.c -I $(GALAHAD)/include -I $(OBJ) + rm $(OBJ)/*.c + @printf '[ OK ]\n' + +# book keeping + +clean: + @printf ' %-9s %-15s\t\t' "Cleaning $(PRECIS) precision spral" + $(RM) $(LGS) $(LGD) $(OBJ)/slblt*.o \ + $(MOD)/spral* + @printf '[ OK ]\n' + +cleanall: + @printf ' %-14s\t\t' \ + "Removing all $(PRECIS) precision object and module files" + $(RM) -r $(OBJ)/* $(MOD)/* + @printf '[ OK ]\n' + +rmslblt: + @printf ' %-9s %-15s\t\t' "Removing" "slblt from archive " + $(RRMARFILE) slblt_$(PRECIS).o + @printf '[ OK ]\n' diff --git a/src/slblt/meson.build b/src/slblt/meson.build new file mode 100644 index 0000000000..3c9cc3cfcb --- /dev/null +++ b/src/slblt/meson.build @@ -0,0 +1,13 @@ +libgalahad_src += files('slblt.F90', 'contrib_iface.F90', + 'types.F90', 'subtree.F90', + 'slblt_factor.F90', 'numeric_subtree.F90') + +libgalahad_c_src += files('C/slblt_ciface.F90') + +galahad_tests += [['slblt', 'slbltt', files('slbltt.F90')], + ['slblt', 'slblt_factort', files('slblt_factort.F90')]] + +galahad_c_tests += [['slblt', 'slbltt_c', files('C/slbltt.c')], + ['slblt', 'slblttf_c', files('C/slblttf.c')]] + +galahad_examples += [['slblts', files('slblts.f90')]] diff --git a/src/slblt/numeric_subtree.F90 b/src/slblt/numeric_subtree.F90 new file mode 100644 index 0000000000..677528b45a --- /dev/null +++ b/src/slblt/numeric_subtree.F90 @@ -0,0 +1,509 @@ +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 17:20 GMT +! +! Pure-Fortran CPU subtree for SLBLT: an implementation of the abstract +! symbolic_subtree_base / numeric_subtree_base (see subtree.F90) that factors and +! solves entirely in Fortran, using the verified multifrontal driver in +! GALAHAD_SLBLT_factor_precision. +! +! It is a drop-in alternative to GALAHAD_SLBLT_numeric_subtree_precision. +! slblt.F90 selects it at analyse time when the environment variable +! GALAHAD_SLBLT_FORTRAN is set to 1. +! +! Scope: serial LDL^T with threshold partial pivoting, delayed pivots and +! foreign child_contrib (all unit-tested standalone). No OpenMP tasking and no +! small-leaf-subtree specialisation (a performance optimisation, not needed for +! correctness). + +#include "galahad_modules.h" + + MODULE GALAHAD_SLBLT_numeric_subtree_precision + USE GALAHAD_KINDS_precision + USE GALAHAD_SLBLT_types_precision, ONLY: SLBLT_control_type, & + SLBLT_inform_type, & + SLBLT_SUCCESS, & + SLBLT_ERROR_ALLOCATION, & + SLBLT_ERROR_SINGULAR, & + SLBLT_ERROR_NOT_POS_DEF, & + PIVOT_METHOD_TPP, & + PIVOT_METHOD_APP_AGGRESIVE, & + FAILED_PIVOT_METHOD_TPP, & + contrib_type + USE GALAHAD_SLBLT_subtree_precision, ONLY : symbolic_subtree_base, & + numeric_subtree_base + USE GALAHAD_SLBLT_factor_precision, ONLY : dmf_node, & + subtree_contrib_t, factor_subtree_delay, extract_contrib, & + subtree_solve_fwd_delay, subtree_solve_diag_delay, & + subtree_solve_bwd_delay + IMPLICIT none + + PRIVATE + PUBLIC :: symbolic_subtree, construct_symbolic_subtree + PUBLIC :: numeric_subtree, free_contrib + + !> Per-node symbolic template (built once at analyse time). + TYPE :: node_symb_type + INTEGER( ip_ ) :: symb_ncol = 0, symb_nrow = 0, parent = 0 + INTEGER( ip_ ), ALLOCATABLE :: rlist(:) ! global rows + INTEGER( long_ ), ALLOCATABLE :: a_src(:) ! src index into aval + INTEGER( ip_ ), ALLOCATABLE :: a_ai(:), a_aj(:) ! symbolic front (r,c) + INTEGER( ip_ ), ALLOCATABLE :: contribs(:) ! local foreign contrib ids + END TYPE node_symb_type + + TYPE, EXTENDS( symbolic_subtree_base ) :: symbolic_subtree + INTEGER( ip_ ) :: n = 0, nnodes = 0 + TYPE( node_symb_type ), ALLOCATABLE :: nodes(:) + CONTAINS + PROCEDURE :: factor + PROCEDURE :: cleanup => symbolic_cleanup + END TYPE symbolic_subtree + + TYPE, EXTENDS( numeric_subtree_base ) :: numeric_subtree + LOGICAL :: posdef = .FALSE. + INTEGER( ip_ ) :: n = 0, nnodes = 0 + TYPE( symbolic_subtree ), POINTER :: symbolic => NULL() + TYPE( dmf_node ), ALLOCATABLE :: fnode(:) + CONTAINS + PROCEDURE :: get_contrib + PROCEDURE :: solve_fwd + PROCEDURE :: solve_diag + PROCEDURE :: solve_diag_bwd + PROCEDURE :: solve_bwd + PROCEDURE :: enquire_posdef + PROCEDURE :: enquire_indef + PROCEDURE :: alter + PROCEDURE :: cleanup => numeric_cleanup + END TYPE numeric_subtree + + CONTAINS + + FUNCTION construct_symbolic_subtree( n, sa, en, sptr, sparent, & + rptr, rlist, nptr, nlist, contrib_idx, control ) RESULT( this ) + CLASS( symbolic_subtree ), POINTER :: this + INTEGER( ip_ ), INTENT( IN ) :: n, sa, en + INTEGER( ip_ ), DIMENSION( * ), INTENT( IN ) :: sptr, sparent, rlist + INTEGER( long_ ), DIMENSION( * ), INTENT( IN ) :: rptr, nptr + INTEGER( long_ ), DIMENSION( 2, * ), INTENT( IN ) :: nlist + INTEGER( ip_ ), DIMENSION( : ), INTENT( IN ) :: contrib_idx + CLASS( SLBLT_control_type ), INTENT( IN ) :: control + INTEGER( ip_ ) :: li, gi, ps, na, k, nrow, ci, tgt + INTEGER( long_ ) :: p0 + NULLIFY( this ) + ALLOCATE( this ) + this%n = n + this%nnodes = en - sa + ALLOCATE( this%nodes( this%nnodes ) ) + DO li = 1, this%nnodes + gi = sa + li - 1 + ASSOCIATE( nd => this%nodes( li ) ) + nd%symb_ncol = INT( sptr( gi+1 ) - sptr( gi ), ip_ ) + nrow = INT( rptr( gi+1 ) - rptr( gi ), ip_ ) + nd%symb_nrow = nrow + ALLOCATE( nd%rlist( nrow ) ) + DO k = 1, nrow + nd%rlist( k ) = rlist( INT( rptr( gi ), ip_ ) + k - 1 ) + END DO + ps = sparent( gi ) + IF ( ps >= sa .AND. ps <= en - 1 ) THEN + nd%parent = ps - sa + 1 + ELSE + nd%parent = 0 + END IF + na = INT( nptr( gi+1 ) - nptr( gi ), ip_ ) + ALLOCATE( nd%a_src( na ), nd%a_ai( na ), nd%a_aj( na ) ) + p0 = nptr( gi ) ! 1-based start into nlist columns + DO k = 1, na + nd%a_src( k ) = nlist( 1, p0 + k - 1 ) + block + integer( long_ ) :: dest0 + dest0 = nlist( 2, p0 + k - 1 ) - 1 ! 0-based front linear index + nd%a_aj( k ) = INT( dest0 / nrow, ip_ ) + 1 + nd%a_ai( k ) = INT( MOD( dest0, INT( nrow, long_ ) ), ip_ ) + 1 + end block + END DO + END ASSOCIATE + END DO + ! record foreign contribution targets + DO ci = 1, SIZE( contrib_idx ) + tgt = contrib_idx( ci ) - sa + 1 + IF ( tgt >= 1 .AND. tgt <= this%nnodes ) & + CALL push( this%nodes( tgt )%contribs, INT( ci, ip_ ) ) + END DO + END FUNCTION construct_symbolic_subtree + + SUBROUTINE push( a, v ) + INTEGER( ip_ ), ALLOCATABLE, INTENT( INOUT ) :: a(:) + INTEGER( ip_ ), INTENT( IN ) :: v + INTEGER( ip_ ), ALLOCATABLE :: tmp(:) + IF ( .NOT. ALLOCATED( a ) ) THEN + ALLOCATE( a( 1 ) ); a( 1 ) = v + ELSE + ALLOCATE( tmp( SIZE( a ) + 1 ) ) + tmp( 1:SIZE( a ) ) = a; tmp( SIZE( a ) + 1 ) = v + CALL MOVE_ALLOC( tmp, a ) + END IF + END SUBROUTINE push + + SUBROUTINE symbolic_cleanup( this ) + CLASS( symbolic_subtree ), INTENT( INOUT ) :: this + IF ( ALLOCATED( this%nodes ) ) DEALLOCATE( this%nodes ) + END SUBROUTINE symbolic_cleanup + + !> Free a contribution block produced by get_contrib (Fortran allocations). + !! Frees the contribution block; called from contrib_iface. + SUBROUTINE free_contrib( fcontrib ) + TYPE( contrib_type ), INTENT( INOUT ) :: fcontrib + IF ( ASSOCIATED( fcontrib%val ) ) DEALLOCATE( fcontrib%val ) + IF ( ASSOCIATED( fcontrib%rlist ) ) DEALLOCATE( fcontrib%rlist ) + IF ( ASSOCIATED( fcontrib%delay_perm ) ) DEALLOCATE( fcontrib%delay_perm ) + IF ( ASSOCIATED( fcontrib%delay_val ) ) DEALLOCATE( fcontrib%delay_val ) + fcontrib%n = 0 + END SUBROUTINE free_contrib + + FUNCTION factor( this, posdef, aval, child_contrib, control, inform, & + scaling ) + CLASS( numeric_subtree_base ), POINTER :: factor + CLASS( symbolic_subtree ), TARGET, INTENT( INOUT ) :: this + LOGICAL, INTENT( IN ) :: posdef + REAL( rp_ ), DIMENSION( * ), TARGET, INTENT( IN ) :: aval + TYPE( contrib_type ), DIMENSION( : ), TARGET, INTENT( INOUT ) :: child_contrib + TYPE( SLBLT_control_type ), INTENT( IN ) :: control + TYPE( SLBLT_inform_type ), INTENT( INOUT ) :: inform + REAL( rp_ ), DIMENSION( * ), TARGET, OPTIONAL, INTENT( IN ) :: scaling + TYPE( numeric_subtree ), POINTER :: fac + TYPE( subtree_contrib_t ), ALLOCATABLE :: contribs(:) + INTEGER( ip_ ) :: li, k, na, st, nb + LOGICAL :: ok, aok + NULLIFY( factor ) + ALLOCATE( fac, STAT = st ); IF ( st /= 0 ) GO TO 10 + fac%symbolic => this + fac%n = this%n + fac%nnodes = this%nnodes + fac%posdef = posdef + ALLOCATE( fac%fnode( this%nnodes ), STAT = st ); IF ( st /= 0 ) GO TO 10 + + ! build numeric nodes from the symbolic template + values of A + DO li = 1, this%nnodes + ASSOCIATE( t => this%nodes( li ), fn => fac%fnode( li ) ) + fn%symb_ncol = t%symb_ncol + fn%symb_nrow = t%symb_nrow + fn%parent = t%parent + fn%rlist = t%rlist + na = SIZE( t%a_src ) + ALLOCATE( fn%ai( na ), fn%aj( na ), fn%av( na ) ) + fn%ai = t%a_ai; fn%aj = t%a_aj + IF ( PRESENT( scaling ) ) THEN + DO k = 1, na + fn%av( k ) = scaling( t%rlist( t%a_ai( k ) ) ) * aval( t%a_src( k ) ) & + * scaling( t%rlist( t%a_aj( k ) ) ) + END DO + ELSE + DO k = 1, na + fn%av( k ) = aval( t%a_src( k ) ) + END DO + END IF + IF ( ALLOCATED( t%contribs ) ) fn%contribs = t%contribs + END ASSOCIATE + END DO + + ! convert incoming child contributions + ALLOCATE( contribs( SIZE( child_contrib ) ), STAT = st ); IF ( st /= 0 ) GO TO 10 + DO k = 1, SIZE( child_contrib ) + CALL import_contrib( child_contrib( k ), contribs( k ) ) + END DO + + ! pivot_method encoded in nb for factor_node_indef: nb=0 -> unblocked TPP; + ! nb>0 -> APP_BLOCK at |nb| = block_size (default 256, inner 32 via + ! recursion); nb<0 -> APP_AGGRESSIVE (optimistic unpivoted-first) at |nb|. + if ( control%pivot_method == PIVOT_METHOD_TPP ) then + nb = 0_ip_ + else if ( control%pivot_method == PIVOT_METHOD_APP_AGGRESIVE ) then + nb = - MAX( 1_ip_, control%block_size ) + else + nb = MAX( 1_ip_, control%block_size ) + end if + CALL factor_subtree_delay( fac%fnode, this%nnodes, this%n, control%action, & + control%u, control%small, nb, posdef, ok, & + contribs, & + small_subtree_threshold & + = control%small_subtree_threshold, & + failed_tpp = ( control%failed_pivot_method & + == FAILED_PIVOT_METHOD_TPP ), & + alloc_ok = aok ) + IF ( .NOT. aok ) THEN + inform%flag = SLBLT_ERROR_ALLOCATION ! out of memory during factor + ELSE IF ( .NOT. ok ) THEN + IF ( posdef ) THEN + inform%flag = SLBLT_ERROR_NOT_POS_DEF + ELSE + inform%flag = SLBLT_ERROR_SINGULAR + END IF + END IF + CALL accumulate_stats( fac, inform ) + factor => fac + RETURN +10 CONTINUE + inform%flag = SLBLT_ERROR_ALLOCATION + inform%stat = st + IF ( ASSOCIATED( fac ) ) DEALLOCATE( fac ) + END FUNCTION factor + + !> Populate inform statistics (pivot counts, rank, factor size) from the + !! factored nodes. + SUBROUTINE accumulate_stats( fac, inform ) + TYPE( numeric_subtree ), INTENT( IN ) :: fac + TYPE( SLBLT_inform_type ), INTENT( INOUT ) :: inform + INTEGER( ip_ ) :: li, i, k, nneg, ntwo, ndel, nzero, nfst, nsnd + REAL( rp_ ) :: d11, d21, d22, det + LOGICAL :: is1x1 + nneg = 0; ntwo = 0; ndel = 0; nzero = 0; nfst = 0; nsnd = 0 + DO li = 1, fac%nnodes + ASSOCIATE( fn => fac%fnode( li ) ) + ndel = ndel + fn%ndelay_out + nfst = nfst + fn%nfirst + nsnd = nsnd + fn%nsecond +! L factor entries and flops: column j (0-based) of the nelim eliminated +! columns has nrow-j sub/diagonal entries -> triangular count + inform%num_factor = inform%num_factor & + + INT( fn%nelim, long_ ) * INT( fn%nrow, long_ ) & + - ( INT( fn%nelim, long_ ) * INT( fn%nelim - 1, long_ ) ) / 2_long_ + DO k = 0, fn%nelim - 1 + inform%num_flops = inform%num_flops + INT( fn%nrow - k, long_ ) ** 2 + END DO + i = 0 + DO WHILE ( i < fn%nelim ) + is1x1 = ( i+1 == fn%nelim ) + IF ( .NOT. is1x1 ) is1x1 = ieee_is_finite_local( fn%d( 2*i+3 ) ) + IF ( is1x1 ) THEN + d11 = fn%d( 2*i+1 ) + IF ( d11 == 0.0_rp_ ) THEN + nzero = nzero + 1 + ELSE IF ( d11 < 0.0_rp_ ) THEN + nneg = nneg + 1 + END IF + i = i + 1 + ELSE + ntwo = ntwo + 1 + d11 = fn%d( 2*i+1 ); d21 = fn%d( 2*i+2 ); d22 = fn%d( 2*i+4 ) + det = d11*d22 - d21*d21 ! det of D^{-1} (same sign as det D) + IF ( det < 0.0_rp_ ) THEN + nneg = nneg + 1 ! indefinite 2x2: one negative + ELSE IF ( d11 + d22 < 0.0_rp_ ) THEN + nneg = nneg + 2 ! both negative (trace<0) + END IF + i = i + 2 + END IF + END DO + END ASSOCIATE + END DO + ! thread_inform is fresh (0); reduce() sums these into the global inform, + ! whose matrix_rank starts at n (set by analyse) -- so subtract num_zero. + inform%matrix_rank = inform%matrix_rank - nzero + inform%num_neg = inform%num_neg + nneg + inform%num_two = inform%num_two + ntwo + inform%num_delay = inform%num_delay + ndel + inform%not_first_pass = inform%not_first_pass + nfst + inform%not_second_pass = inform%not_second_pass + nsnd + END SUBROUTINE accumulate_stats + + !> contrib_type (GALAHAD interchange) -> subtree_contrib_t (driver form). + SUBROUTINE import_contrib( c, ct ) + TYPE( contrib_type ), INTENT( IN ) :: c + TYPE( subtree_contrib_t ), INTENT( OUT ) :: ct + INTEGER( ip_ ) :: i, j + ct%cn = c%n + ct%ndelay = c%ndelay + IF ( c%n > 0 ) THEN + ALLOCATE( ct%rlist( c%n ) ); ct%rlist = c%rlist( 1:c%n ) + ALLOCATE( ct%val( c%n, c%n ) ) + DO i = 1, c%n + DO j = 1, c%n + ct%val( j, i ) = c%val( ( i-1 )*c%ldval + j ) + END DO + END DO + END IF + IF ( c%ndelay > 0 ) THEN + ALLOCATE( ct%delay_perm( c%ndelay ) ) + ct%delay_perm = c%delay_perm( 1:c%ndelay ) + ALLOCATE( ct%delay_val( c%lddelay, c%ndelay ) ) + DO i = 1, c%ndelay + DO j = 1, c%lddelay + ct%delay_val( j, i ) = c%delay_val( ( i-1 )*c%lddelay + j ) + END DO + END DO + END IF + END SUBROUTINE import_contrib + + SUBROUTINE numeric_cleanup( this ) + CLASS( numeric_subtree ), INTENT( INOUT ) :: this + IF ( ALLOCATED( this%fnode ) ) DEALLOCATE( this%fnode ) + NULLIFY( this%symbolic ) + END SUBROUTINE numeric_cleanup + + FUNCTION get_contrib( this ) + TYPE( contrib_type ) :: get_contrib + CLASS( numeric_subtree ), INTENT( IN ) :: this + TYPE( subtree_contrib_t ) :: ct + INTEGER( ip_ ) :: root, li, i, j, cm + root = 0 + DO li = 1, this%nnodes + IF ( this%fnode( li )%parent == 0 ) root = li + END DO + CALL extract_contrib( this%fnode( root ), ct ) + cm = ct%cn + get_contrib%n = cm + get_contrib%ndelay = ct%ndelay + get_contrib%posdef = this%posdef + IF ( cm > 0 ) THEN + get_contrib%ldval = cm + ALLOCATE( get_contrib%val( cm*cm ) ) + DO i = 1, cm + DO j = 1, cm + get_contrib%val( ( i-1 )*cm + j ) = ct%val( j, i ) + END DO + END DO + ALLOCATE( get_contrib%rlist( cm ) ); get_contrib%rlist = ct%rlist + END IF + IF ( ct%ndelay > 0 ) THEN + get_contrib%lddelay = ct%ndelay + cm + ALLOCATE( get_contrib%delay_perm( ct%ndelay ) ) + get_contrib%delay_perm = ct%delay_perm + ALLOCATE( get_contrib%delay_val( ( ct%ndelay + cm )*ct%ndelay ) ) + DO i = 1, ct%ndelay + DO j = 1, ct%ndelay + cm + get_contrib%delay_val( ( i-1 )*( ct%ndelay + cm ) + j ) & + = ct%delay_val( j, i ) + END DO + END DO + ELSE + NULLIFY( get_contrib%delay_perm ) + NULLIFY( get_contrib%delay_val ) + END IF + END FUNCTION get_contrib + + SUBROUTINE solve_fwd( this, nrhs, x, ldx, inform ) + CLASS( numeric_subtree ), INTENT( INOUT ) :: this + INTEGER( ip_ ), INTENT( IN ) :: nrhs + REAL( rp_ ), DIMENSION( * ), INTENT( INOUT ) :: x + INTEGER( ip_ ), INTENT( IN ) :: ldx + TYPE( SLBLT_inform_type ), INTENT( INOUT ) :: inform + CALL subtree_solve_fwd_delay( this%fnode, this%nnodes, nrhs, x, ldx ) + END SUBROUTINE solve_fwd + + SUBROUTINE solve_diag( this, nrhs, x, ldx, inform ) + CLASS( numeric_subtree ), INTENT( INOUT ) :: this + INTEGER( ip_ ), INTENT( IN ) :: nrhs + REAL( rp_ ), DIMENSION( * ), INTENT( INOUT ) :: x + INTEGER( ip_ ), INTENT( IN ) :: ldx + TYPE( SLBLT_inform_type ), INTENT( INOUT ) :: inform + CALL subtree_solve_diag_delay( this%fnode, this%nnodes, nrhs, x, ldx ) + END SUBROUTINE solve_diag + + SUBROUTINE solve_diag_bwd( this, nrhs, x, ldx, inform ) + CLASS( numeric_subtree ), INTENT( INOUT ) :: this + INTEGER( ip_ ), INTENT( IN ) :: nrhs + REAL( rp_ ), DIMENSION( * ), INTENT( INOUT ) :: x + INTEGER( ip_ ), INTENT( IN ) :: ldx + TYPE( SLBLT_inform_type ), INTENT( INOUT ) :: inform + CALL subtree_solve_diag_delay( this%fnode, this%nnodes, nrhs, x, ldx ) + CALL subtree_solve_bwd_delay( this%fnode, this%nnodes, nrhs, x, ldx ) + END SUBROUTINE solve_diag_bwd + + SUBROUTINE solve_bwd( this, nrhs, x, ldx, inform ) + CLASS( numeric_subtree ), INTENT( INOUT ) :: this + INTEGER( ip_ ), INTENT( IN ) :: nrhs + REAL( rp_ ), DIMENSION( * ), INTENT( INOUT ) :: x + INTEGER( ip_ ), INTENT( IN ) :: ldx + TYPE( SLBLT_inform_type ), INTENT( INOUT ) :: inform + CALL subtree_solve_bwd_delay( this%fnode, this%nnodes, nrhs, x, ldx ) + END SUBROUTINE solve_bwd + + SUBROUTINE enquire_posdef( this, d ) + CLASS( numeric_subtree ), INTENT( IN ) :: this + REAL( rp_ ), DIMENSION( * ), INTENT( OUT ) :: d + INTEGER( ip_ ) :: li, i, kk +! return the Cholesky diagonal L_ii, not the pivot L_ii^2. +! chol_factor_node stores d(2i-1) = 1/L_ii^2, so L_ii = sqrt( 1/d(2i-1) ). + kk = 0 + DO li = 1, this%nnodes + ASSOCIATE( fn => this%fnode( li ) ) + DO i = 1, fn%nelim + kk = kk + 1 + IF ( fn%d( 2*i-1 ) /= 0.0_rp_ ) THEN + d( kk ) = SQRT( 1.0_rp_ / fn%d( 2*i-1 ) ) + ELSE + d( kk ) = 0.0_rp_ + END IF + END DO + END ASSOCIATE + END DO + END SUBROUTINE enquire_posdef + + SUBROUTINE enquire_indef( this, piv_order, d ) + CLASS( numeric_subtree ), INTENT( IN ) :: this + INTEGER( ip_ ), DIMENSION( * ), INTENT( OUT ), OPTIONAL :: piv_order + REAL( rp_ ), DIMENSION( * ), INTENT( OUT ), OPTIONAL :: d + INTEGER( ip_ ) :: li, i, piv, dk + LOGICAL :: is1x1 + piv = 0; dk = 0 + DO li = 1, this%nnodes + ASSOCIATE( fn => this%fnode( li ) ) + i = 0 + DO WHILE ( i < fn%nelim ) + is1x1 = ( i+1 == fn%nelim ) + IF ( .NOT. is1x1 ) is1x1 = ieee_is_finite_local( fn%d( 2*i+3 ) ) + IF ( is1x1 ) THEN + IF ( PRESENT( piv_order ) ) THEN + piv_order( fn%perm( i+1 ) ) = piv; piv = piv + 1 + END IF + IF ( PRESENT( d ) ) THEN + d( dk+1 ) = fn%d( 2*i+1 ); d( dk+2 ) = 0.0_rp_; dk = dk + 2 + END IF + i = i + 1 + ELSE + IF ( PRESENT( piv_order ) ) THEN + piv_order( fn%perm( i+1 ) ) = -piv; piv = piv + 1 + piv_order( fn%perm( i+2 ) ) = -piv; piv = piv + 1 + END IF + IF ( PRESENT( d ) ) THEN + d( dk+1 ) = fn%d( 2*i+1 ); d( dk+2 ) = fn%d( 2*i+2 ) + d( dk+3 ) = fn%d( 2*i+4 ); d( dk+4 ) = 0.0_rp_; dk = dk + 4 + END IF + i = i + 2 + END IF + END DO + END ASSOCIATE + END DO + END SUBROUTINE enquire_indef + + SUBROUTINE alter( this, d ) + CLASS( numeric_subtree ), INTENT( INOUT ) :: this + REAL( rp_ ), DIMENSION( * ), INTENT( IN ) :: d + INTEGER( ip_ ) :: li, i, dk + LOGICAL :: is1x1 + dk = 0 + DO li = 1, this%nnodes + ASSOCIATE( fn => this%fnode( li ) ) + i = 0 + DO WHILE ( i < fn%nelim ) + is1x1 = ( i+1 == fn%nelim ) + IF ( .NOT. is1x1 ) is1x1 = ieee_is_finite_local( fn%d( 2*i+3 ) ) + IF ( is1x1 ) THEN + fn%d( 2*i+1 ) = d( dk+1 ); dk = dk + 2 + i = i + 1 + ELSE + fn%d( 2*i+1 ) = d( dk+1 ); fn%d( 2*i+2 ) = d( dk+2 ) + fn%d( 2*i+4 ) = d( dk+3 ); dk = dk + 4 + i = i + 2 + END IF + END DO + END ASSOCIATE + END DO + END SUBROUTINE alter + + LOGICAL FUNCTION ieee_is_finite_local( v ) RESULT( f ) + USE, INTRINSIC :: ieee_arithmetic, ONLY : ieee_is_finite + REAL( rp_ ), INTENT( IN ) :: v + f = ieee_is_finite( v ) + END FUNCTION ieee_is_finite_local + + END MODULE GALAHAD_SLBLT_numeric_subtree_precision diff --git a/src/ssids/ssids.F90 b/src/slblt/slblt.F90 similarity index 81% rename from src/ssids/ssids.F90 rename to src/slblt/slblt.F90 index c033e503d5..e35aee9317 100644 --- a/src/ssids/ssids.F90 +++ b/src/slblt/slblt.F90 @@ -1,31 +1,32 @@ -! THIS VERSION: GALAHAD 5.4 - 2025-11-29 AT 13:30 GMT +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 14:10 GMT ! (consistent with SPRAL up to issue #250) #include "galahad_modules.h" -!-*-*-*-*-*-*-*-*- G A L A H A D _ S S I D S M O D U L E *-*-*-*-*-*-*-*-*- +!-*-*-*-*-*-*-*-*- G A L A H A D _ S L B L T M O D U L E *-*-*-*-*-*-*-*-*- ! COPYRIGHT (c) 2011 The Science and Technology Facilities Council (STFC) +! additions Copyright reserved, Gould/Orban/Toint, for GALAHAD productions ! licence: BSD licence, see LICENCE file for details ! authors: Jonathan Hogg and Jennifer Scott ! Forked from SPRAL and extended for GALAHAD, Nick Gould, version 3.1, 2016 -! Absorbed SSIDS_analyse, SSIDS_fkeep, SPRAL_CORE_ANALYSE +! Absorbed SLBLT_analyse, SLBLT_fkeep, SPRAL_CORE_ANALYSE ! & SPRAL_pgm modules, version 5.3, 2025 - MODULE GALAHAD_SSIDS_precision + MODULE GALAHAD_SLBLT_precision ! ------------------------------------------------------------ ! | | -! | SSIDS, a sparse, symmetric, idefinite direct linear solver | +! | SLBLT, a sparse, symmetric, idefinite direct linear solver | ! | | ! ------------------------------------------------------------ USE, INTRINSIC :: iso_c_binding !$ USE omp_lib USE GALAHAD_KINDS_precision - USE GALAHAD_HW, ONLY: HW_guess_topology, HW_numa_region - USE GALAHAD_MU_precision, ONLY: SSIDS_MATRIX_REAL_SYM_INDEF, & - SSIDS_MATRIX_REAL_SYM_PSDEF, & + USE GALAHAD_TOPOLOGY, ONLY: TOPOLOGY_guess_topology, TOPOLOGY_numa_region + USE GALAHAD_MU_precision, ONLY: SLBLT_MATRIX_REAL_SYM_INDEF, & + SLBLT_MATRIX_REAL_SYM_PSDEF, & MU_convert_coord_to_cscl, & MU_clean_cscl_oop, & MU_apply_conversion_map @@ -41,29 +42,23 @@ MODULE GALAHAD_SSIDS_precision USE GALAHAD_NODEND_precision, ONLY: NODEND_half_order, & NODEND_control_type, & NODEND_inform_type - USE GALAHAD_SSIDS_types_precision - USE GALAHAD_SSIDS_subtree_precision, ONLY: numeric_subtree_base, & + USE GALAHAD_SLBLT_types_precision + USE GALAHAD_SLBLT_subtree_precision, ONLY: numeric_subtree_base, & symbolic_subtree_base - USE GALAHAD_SSIDS_cpu_subtree_precision, ONLY: cpu_numeric_subtree, & - construct_cpu_symbolic_subtree -! USE GALAHAD_SSIDS_gpu_subtree_precision, ONLY: & -! construct_gpu_symbolic_subtree -#ifdef PROFILE - USE GALAHAD_SSIDS_profile_precision, ONLY : profile_begin, profile_end, & - profile_add_event -#endif + USE GALAHAD_SLBLT_numeric_subtree_precision, ONLY: & + construct_symbolic_subtree, & + numeric_subtree IMPLICIT NONE PRIVATE - PUBLIC :: SSIDS_analyse, SSIDS_analyse_coord, SSIDS_factor, SSIDS_solve, & - SSIDS_free, SSIDS_enquire_posdef, SSIDS_enquire_indef, & - SSIDS_alter, SSIDS_control_type, SSIDS_inform_type + PUBLIC :: SLBLT_analyse, SLBLT_analyse_coord, SLBLT_factor, SLBLT_solve, & + SLBLT_free, SLBLT_enquire_posdef, SLBLT_enquire_indef, & + SLBLT_alter, SLBLT_control_type, SLBLT_inform_type !---------------------- ! P a r a m e t e r s !---------------------- - LOGICAL, PUBLIC, PROTECTED :: ssids_available = .TRUE. INTEGER( ip_ ), PARAMETER, PUBLIC :: DEBUG_PRINT_LEVEL = 9999 ! extracted from SPRAL_CORE_ANALYSE @@ -76,57 +71,57 @@ MODULE GALAHAD_SSIDS_precision ! analyse phase, CSC-lower input - INTERFACE SSIDS_analyse + INTERFACE SLBLT_analyse MODULE PROCEDURE analyse_precision, analyse_precision_ptr32 - END INTERFACE SSIDS_analyse + END INTERFACE SLBLT_analyse ! analyse phase, coordinate input - INTERFACE SSIDS_analyse_coord - MODULE PROCEDURE ssids_analyse_coord_precision - END INTERFACE SSIDS_analyse_coord + INTERFACE SLBLT_analyse_coord + MODULE PROCEDURE slblt_analyse_coord_precision + END INTERFACE SLBLT_analyse_coord ! factorize phase - INTERFACE SSIDS_factor - MODULE PROCEDURE ssids_factor_ptr32_precision - MODULE PROCEDURE ssids_factor_ptr64_precision - END INTERFACE SSIDS_factor + INTERFACE SLBLT_factor + MODULE PROCEDURE slblt_factor_ptr32_precision + MODULE PROCEDURE slblt_factor_ptr64_precision + END INTERFACE SLBLT_factor ! solve phase - INTERFACE SSIDS_solve - MODULE PROCEDURE ssids_solve_one_precision - MODULE PROCEDURE ssids_solve_mult_precision - END INTERFACE SSIDS_solve + INTERFACE SLBLT_solve + MODULE PROCEDURE slblt_solve_one_precision + MODULE PROCEDURE slblt_solve_mult_precision + END INTERFACE SLBLT_solve ! free akeep and/or fkeep - INTERFACE SSIDS_free + INTERFACE SLBLT_free MODULE PROCEDURE free_akeep_precision MODULE PROCEDURE free_fkeep_precision MODULE PROCEDURE free_both_precision - END INTERFACE SSIDS_free + END INTERFACE SLBLT_free ! pivot information in positive definite case - INTERFACE SSIDS_enquire_posdef - MODULE PROCEDURE ssids_enquire_posdef_precision - END INTERFACE SSIDS_enquire_posdef + INTERFACE SLBLT_enquire_posdef + MODULE PROCEDURE slblt_enquire_posdef_precision + END INTERFACE SLBLT_enquire_posdef ! pivot information in indefinite case - INTERFACE SSIDS_enquire_indef - MODULE PROCEDURE ssids_enquire_indef_precision - END INTERFACE SSIDS_enquire_indef + INTERFACE SLBLT_enquire_indef + MODULE PROCEDURE slblt_enquire_indef_precision + END INTERFACE SLBLT_enquire_indef ! alter diagonal - INTERFACE SSIDS_alter - MODULE PROCEDURE ssids_alter_precision - END INTERFACE SSIDS_alter + INTERFACE SLBLT_alter + MODULE PROCEDURE slblt_alter_precision + END INTERFACE SLBLT_alter -! extracted from ssids_analyse +! extracted from slblt_analyse INTERFACE print_atree MODULE PROCEDURE print_atree, print_atree_part @@ -142,7 +137,7 @@ MODULE GALAHAD_SSIDS_precision END TYPE omp_settings ! ------------------------- -! extracts from SSIDS_akeep +! extracts from SLBLT_akeep ! ------------------------- TYPE symbolic_subtree_ptr @@ -152,7 +147,7 @@ MODULE GALAHAD_SSIDS_precision ! type for information generated in analyse phase - TYPE, PUBLIC :: SSIDS_akeep_type + TYPE, PUBLIC :: SLBLT_akeep_type ! copy of check as input to analyse phase @@ -190,30 +185,30 @@ MODULE GALAHAD_SSIDS_precision ! rlist(rptr(i):rptr(i+1)-1) contains the row indices for node i of the ! assembly tree. At each node, the list is in elimination order. -! Allocated within basic_analyse in ssids +! Allocated within basic_analyse in slblt INTEGER( ip_ ), DIMENSION( : ), ALLOCATABLE :: rlist ! pointers into rlist for nodes of assembly tree. Has length nnodes+1. -! Allocated within basic_analyse in ssids +! Allocated within basic_analyse in slblt INTEGER( long_ ), DIMENSION( : ), ALLOCATABLE :: rptr ! sparent(i) is the parent of node i in assembly tree. sparent(i)=nnodes+1 if ! i is a root. The parent is always numbered higher than each of its children. -! Allocated within basic_analyse in ssids +! Allocated within basic_analyse in slblt INTEGER( ip_ ), DIMENSION( : ), ALLOCATABLE :: sparent ! (super)node pointers. Supernode i consists of sptr(i) through sptr(i+1)-1. -! Allocated within basic_analyse in ssids +! Allocated within basic_analyse in slblt INTEGER( ip_ ), DIMENSION( : ), ALLOCATABLE :: sptr ! the following components are for cleaned up matrix data. LOWER triangle ! only. We have to retain these for factorize phase as used if the user wants ! to do scaling. These components are NOT used if check is set to .false. -! on call to ssids_analyse +! on call to slblt_analyse INTEGER( long_ ), ALLOCATABLE :: ptr( : ) ! column pointers INTEGER( ip_ ), ALLOCATABLE :: row( : ) ! row indices @@ -226,24 +221,24 @@ MODULE GALAHAD_SSIDS_precision ! machine topology - TYPE( HW_numa_region ), DIMENSION( : ), ALLOCATABLE :: topology + TYPE( TOPOLOGY_numa_region ), DIMENSION( : ), ALLOCATABLE :: topology ! inform at end of analyse phase - TYPE( ssids_inform_type ) :: inform + TYPE( slblt_inform_type ) :: inform CONTAINS PROCEDURE, PASS( akeep ) :: free => free_akeep -! finalizer: release C++ symbolic subtrees on deallocation/reset/scope-exit +! finalizer: release symbolic subtrees on deallocation/reset/scope-exit FINAL :: final_akeep - END TYPE SSIDS_akeep_type + END TYPE SLBLT_akeep_type ! ------------------------- -! extracts from SSIDS_fkeep +! extracts from SLBLT_fkeep ! ------------------------- TYPE numeric_subtree_ptr @@ -252,7 +247,7 @@ MODULE GALAHAD_SSIDS_precision ! type for data generated in factorise phase - TYPE, PUBLIC :: SSIDS_fkeep_type + TYPE, PUBLIC :: SLBLT_fkeep_type ! stores scaling for each entry ( in original matrix order ) @@ -265,30 +260,30 @@ MODULE GALAHAD_SSIDS_precision ! copy of inform on exit from factorize - TYPE( ssids_inform_type ) :: inform + TYPE( slblt_inform_type ) :: inform CONTAINS ! do actual factorization - PROCEDURE, PASS( fkeep ) :: inner_factor => inner_factor_cpu + PROCEDURE, PASS( fkeep ) :: inner_factor => inner_factor ! do actual solve - PROCEDURE, PASS( fkeep ) :: inner_solve => inner_solve_cpu - PROCEDURE, PASS( fkeep ) :: enquire_posdef => enquire_posdef_cpu - PROCEDURE, PASS( fkeep ) :: enquire_indef => enquire_indef_cpu - PROCEDURE, PASS( fkeep ) :: alter => alter_cpu ! Alter D values + PROCEDURE, PASS( fkeep ) :: inner_solve => inner_solve + PROCEDURE, PASS( fkeep ) :: enquire_posdef => enquire_posdef + PROCEDURE, PASS( fkeep ) :: enquire_indef => enquire_indef + PROCEDURE, PASS( fkeep ) :: alter => alter ! Alter D values PROCEDURE, PASS( fkeep ) :: free => free_fkeep ! Frees memory -! finalizer: release C++ numeric subtrees on deallocation/reset/scope-exit +! finalizer: release numeric subtrees on deallocation/reset/scope-exit FINAL :: final_fkeep - END TYPE SSIDS_fkeep_type + END TYPE SLBLT_fkeep_type CONTAINS -!-*-*- G A L A H A D - S S I D S _ analyse_ptr32 S U B R O U T I N E -*-*- +!-*-*- G A L A H A D - S L B L T _ analyse_ptr32 S U B R O U T I N E -*-*- SUBROUTINE analyse_precision_ptr32( check, n, ptr, row, akeep, control, & inform, order, val, topology ) @@ -301,12 +296,12 @@ SUBROUTINE analyse_precision_ptr32( check, n, ptr, row, akeep, control, & INTEGER( KIND = ip_ ), INTENT( IN ) :: n INTEGER( KIND = i4_ ), INTENT( IN ) :: ptr( : ) INTEGER( KIND = ip_ ), INTENT( IN ) :: row( : ) - TYPE( SSIDS_akeep_type ), INTENT( INOUT ) :: akeep - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( OUT ) :: inform + TYPE( SLBLT_akeep_type ), INTENT( INOUT ) :: akeep + TYPE( SLBLT_control_type ), INTENT( IN ) :: control + TYPE( SLBLT_inform_type ), INTENT( OUT ) :: inform INTEGER( KIND = ip_ ), OPTIONAL, INTENT( INOUT ) :: order( : ) REAL( KIND = rp_ ), OPTIONAL, INTENT( IN ) :: val( : ) - TYPE( HW_numa_region ), DIMENSION( : ), OPTIONAL, INTENT( IN ) :: topology + TYPE( TOPOLOGY_numa_region ), DIMENSION( : ), OPTIONAL, INTENT( IN ) :: topology ! local variables @@ -316,9 +311,9 @@ SUBROUTINE analyse_precision_ptr32( check, n, ptr, row, akeep, control, & ALLOCATE( ptr64( n + 1 ), stat=inform%stat ) IF ( inform%stat /= 0 ) THEN - inform%flag = SSIDS_ERROR_ALLOCATION + inform%flag = SLBLT_ERROR_ALLOCATION akeep%inform = inform - CALL inform%print_flag( control, 'ssids_analyse' ) + CALL inform%print_flag( control, 'slblt_analyse' ) RETURN END IF ptr64( 1 : n + 1 ) = ptr( 1 : n + 1 ) @@ -331,7 +326,7 @@ SUBROUTINE analyse_precision_ptr32( check, n, ptr, row, akeep, control, & END SUBROUTINE analyse_precision_ptr32 -!-*-*- G A L A H A D - S S I D S _ a n a l y s e S U B R O U T I N E -*-*- +!-*-*- G A L A H A D - S L B L T _ a n a l y s e S U B R O U T I N E -*-*- SUBROUTINE analyse_precision( check, n, ptr, row, akeep, control, inform, & order, val, topology ) @@ -367,15 +362,15 @@ SUBROUTINE analyse_precision( check, n, ptr, row, akeep, control, inform, & ! symbolic factorization output - TYPE( SSIDS_akeep_type ), INTENT( INOUT ) :: akeep + TYPE( SLBLT_akeep_type ), INTENT( INOUT ) :: akeep ! user-supplied options - TYPE( SSIDS_control_type ), INTENT( IN ) :: control + TYPE( SLBLT_control_type ), INTENT( IN ) :: control ! stats/information returned to the user - TYPE( SSIDS_inform_type ), INTENT( OUT ) :: inform + TYPE( SLBLT_inform_type ), INTENT( OUT ) :: inform ! return ordering to user/allow user to supply order @@ -387,7 +382,7 @@ SUBROUTINE analyse_precision( check, n, ptr, row, akeep, control, inform, & ! optionally Specify machine topology to work with - TYPE( HW_numa_region ), DIMENSION( : ), OPTIONAL, INTENT( IN ) :: topology + TYPE( TOPOLOGY_numa_region ), DIMENSION( : ), OPTIONAL, INTENT( IN ) :: topology ! local variables @@ -415,20 +410,13 @@ SUBROUTINE analyse_precision( check, n, ptr, row, akeep, control, inform, & INTEGER( KIND = ip_ ) :: mo_flag INTEGER( KIND = ip_ ) :: free_flag - TYPE( ssids_inform_type ) :: inform_default + TYPE( slblt_inform_type ) :: inform_default ! initialise - context = 'ssids_analyse' + context = 'slblt_analyse' inform = inform_default - CALL ssids_free( akeep, free_flag ) -! IF ( free_flag /= 0 ) THEN -! inform%flag = SSIDS_ERROR_CUDA_UNKNOWN -! inform%cuda_error = free_flag -! akeep%inform = inform -! CALL inform%print_flag( control, context ) -! RETURN -! END IF + CALL slblt_free( akeep, free_flag ) ! print status on entry @@ -445,7 +433,7 @@ SUBROUTINE analyse_precision( check, n, ptr, row, akeep, control, inform, & ! checking of matrix data IF ( n < 0 ) THEN - inform%flag = SSIDS_ERROR_A_N_OOR + inform%flag = SLBLT_ERROR_A_N_OOR akeep%inform = inform CALL inform%print_flag( control, context ) RETURN @@ -464,7 +452,7 @@ SUBROUTINE analyse_precision( check, n, ptr, row, akeep, control, inform, & ! check control%ordering has a valid value IF ( control%ordering < 0 .OR. control%ordering > 2 ) THEN - inform%flag = SSIDS_ERROR_ORDER + inform%flag = SLBLT_ERROR_ORDER akeep%inform = inform CALL inform%print_flag( control, context ) RETURN @@ -474,7 +462,7 @@ SUBROUTINE analyse_precision( check, n, ptr, row, akeep, control, inform, & IF ( control%ordering == 2 ) THEN IF ( .NOT. PRESENT( val ) ) THEN - inform%flag = SSIDS_ERROR_VAL + inform%flag = SLBLT_ERROR_VAL akeep%inform = inform CALL inform%print_flag( control, context ) RETURN @@ -487,13 +475,13 @@ SUBROUTINE analyse_precision( check, n, ptr, row, akeep, control, inform, & IF ( st /= 0 ) GO TO 490 IF ( PRESENT( val ) ) THEN - CALL MU_clean_cscl_oop( SSIDS_MATRIX_REAL_SYM_INDEF, n, n, ptr, row, & + CALL MU_clean_cscl_oop( SLBLT_MATRIX_REAL_SYM_INDEF, n, n, ptr, row, & akeep%ptr, akeep%row, mu_flag, val_in = val, & val_out = val_clean, lmap = akeep%lmap, & map = akeep%map, noor = inform%matrix_outrange, & ndup = inform%matrix_dup ) ELSE - CALL MU_clean_cscl_oop( SSIDS_MATRIX_REAL_SYM_INDEF, n, n, ptr, row, & + CALL MU_clean_cscl_oop( SLBLT_MATRIX_REAL_SYM_INDEF, n, n, ptr, row, & akeep%ptr, akeep%row, mu_flag, lmap = akeep%lmap, & map = akeep%map, noor = inform%matrix_outrange, & ndup = inform%matrix_dup ) @@ -502,10 +490,10 @@ SUBROUTINE analyse_precision( check, n, ptr, row, akeep, control, inform, & ! check for errors IF ( mu_flag < 0 ) THEN - IF ( mu_flag == - 1 ) inform%flag = SSIDS_ERROR_ALLOCATION - IF ( mu_flag == - 5 ) inform%flag = SSIDS_ERROR_A_PTR - IF ( mu_flag == - 6 ) inform%flag = SSIDS_ERROR_A_PTR - IF ( mu_flag == - 10 ) inform%flag = SSIDS_ERROR_A_ALL_OOR + IF ( mu_flag == - 1 ) inform%flag = SLBLT_ERROR_ALLOCATION + IF ( mu_flag == - 5 ) inform%flag = SLBLT_ERROR_A_PTR + IF ( mu_flag == - 6 ) inform%flag = SLBLT_ERROR_A_PTR + IF ( mu_flag == - 10 ) inform%flag = SLBLT_ERROR_A_ALL_OOR akeep%inform = inform CALL inform%print_flag( control, context ) RETURN @@ -543,7 +531,7 @@ SUBROUTINE analyse_precision( check, n, ptr, row, akeep, control, inform, & ! raise an error if the user claims but fails to supply the order IF ( .NOT. PRESENT( order ) ) THEN - inform%flag = SSIDS_ERROR_ORDER + inform%flag = SLBLT_ERROR_ORDER akeep%inform = inform CALL inform%print_flag( control, context ) RETURN @@ -600,14 +588,14 @@ SUBROUTINE analyse_precision( check, n, ptr, row, akeep, control, inform, & ! singularity warning required CASE( 1 ) - inform%flag = SSIDS_WARNING_ANALYSIS_SINGULAR + inform%flag = SLBLT_WARNING_ANALYSIS_SINGULAR CASE( - 1 ) - inform%flag = SSIDS_ERROR_ALLOCATION + inform%flag = SLBLT_ERROR_ALLOCATION akeep%inform = inform CALL inform%print_flag( control, context ) RETURN CASE default - inform%flag = SSIDS_ERROR_UNKNOWN + inform%flag = SLBLT_ERROR_UNKNOWN akeep%inform = inform CALL inform%print_flag( control, context ) RETURN @@ -627,7 +615,7 @@ SUBROUTINE analyse_precision( check, n, ptr, row, akeep, control, inform, & ! guess it ELSE - CALL HW_guess_topology( akeep%topology, st ) + CALL TOPOLOGY_guess_topology( akeep%topology, st ) IF ( st /= 0 ) GO TO 490 END IF CALL squash_topology( akeep%topology, control, st ) @@ -649,14 +637,14 @@ SUBROUTINE analyse_precision( check, n, ptr, row, akeep, control, inform, & 490 CONTINUE inform%stat = st - IF ( inform%stat /= 0 ) inform%flag = SSIDS_ERROR_ALLOCATION + IF ( inform%stat /= 0 ) inform%flag = SLBLT_ERROR_ALLOCATION akeep%inform = inform CALL inform%print_flag( control, context ) RETURN END SUBROUTINE analyse_precision -!-*-*- G A L A H A D - S S I D S _ squash_topology S U B R O U T I N E -*-*- +!-*-*- G A L A H A D - S L B L T _ squash_topology S U B R O U T I N E -*-*- SUBROUTINE squash_topology( topology, control, st ) @@ -664,114 +652,41 @@ SUBROUTINE squash_topology( topology, control, st ) ! parameters tell us to ignore. IMPLICIT NONE - TYPE( HW_numa_region ), DIMENSION( : ), ALLOCATABLE, & + TYPE( TOPOLOGY_numa_region ), DIMENSION( : ), ALLOCATABLE, & INTENT( INOUT ) :: topology - TYPE( ssids_control_type ), INTENT( IN ) :: control + TYPE( slblt_control_type ), INTENT( IN ) :: control INTEGER( KIND = ip_ ), INTENT( OUT ) :: st ! local variables LOGICAL :: no_omp - INTEGER( KIND = ip_ ) :: i, j, ngpu - TYPE( HW_numa_region ), DIMENSION( : ), ALLOCATABLE :: new_topology + INTEGER( KIND = ip_ ) :: i + TYPE( TOPOLOGY_numa_region ), DIMENSION( : ), ALLOCATABLE :: new_topology st = 0 no_omp = .TRUE. !$ no_omp = .FALSE. -! get rid of GPUs if we're not using them - - IF ( .NOT. control%use_gpu ) THEN - DO i = 1, SIZE( topology ) - IF ( SIZE( topology( i )%gpus ) /= 0 ) THEN - DEALLOCATE( topology( i )%gpus ) - ALLOCATE( topology( i )%gpus( 0 ), STAT = st ) - IF ( st /= 0 ) RETURN - END IF - END DO - END IF + IF ( no_omp ) THEN -! FIXME: One can envisage a sensible coexistence of both -! no_omp=.true. AND control%ignore_numa=.false. ( e.g., choose the -! "best" NUMA node, with the least utilised CPUs and/or GPUs... ). +! no OpenMP: collapse to a single region with one processor - IF ( no_omp ) THEN ALLOCATE( new_topology( 1 ), STAT = st ) IF ( st /= 0 ) RETURN new_topology( 1 )%nproc = 1 - -! count resources to REALlocate - - ngpu = 0 - DO i = 1, SIZE( topology ) - ngpu = ngpu + SIZE( topology( i )%gpus ) - END DO - -! FIXME: if no_omp=.true. AND control%ignore_numa=.true., -! then take the "first" GPU ( whichever it might be ), only. -! A combination not meant for production, only for testing! - - IF ( control%ignore_numa ) ngpu = min( ngpu, 1 ) - -! store list of GPUs - - ALLOCATE( new_topology( 1 )%gpus( ngpu ), STAT = st ) - IF ( st /= 0 ) RETURN - IF ( ngpu > 0 ) THEN - IF ( control%ignore_numa ) THEN - new_topology( 1 )%gpus( 1 ) = huge( new_topology( 1 )%gpus( 1 ) ) - DO i = 1, SIZE( topology ) - new_topology( 1 )%gpus( 1 ) = & - MIN( new_topology( 1 )%gpus( 1 ), MINVAL( topology( i )%gpus ) ) - END DO - ELSE - ngpu = 0 - DO i = 1, SIZE( topology ) - DO j = 1, SIZE( topology( i )%gpus ) - new_topology( 1 )%gpus( ngpu + j ) = topology( i )%gpus( j ) - END DO - ngpu = ngpu + SIZE( topology( i )%gpus ) - END DO - END IF - END IF - -! move new_topology into place, deallocating old one - DEALLOCATE( topology ) CALL move_alloc( new_topology, topology ) -! squash everything to single NUMA region if we're ignoring numa +! squash everything to a single NUMA region if we're ignoring numa ELSE IF ( SIZE( topology ) > 1 .AND. control%ignore_numa ) THEN ALLOCATE( new_topology( 1 ), STAT = st ) IF ( st /= 0 ) RETURN - -! count resources to REALlocate - new_topology( 1 )%nproc = 0 - ngpu = 0 DO i = 1, SIZE( topology ) new_topology( 1 )%nproc = new_topology( 1 )%nproc + topology( i )%nproc - ngpu = ngpu + SIZE( topology( i )%gpus ) END DO - -! store list of GPUs - - ALLOCATE( new_topology( 1 )%gpus( ngpu ), STAT = st ) - IF ( st /= 0 ) RETURN - IF ( ngpu > 0 ) THEN - ngpu = 0 - DO i = 1, SIZE( topology ) - DO j = 1, SIZE( topology( i )%gpus ) - new_topology( 1 )%gpus( ngpu + j ) = topology( i )%gpus( j ) - END DO - ngpu = ngpu + SIZE( topology( i )%gpus ) - END DO - END IF - -! move new_topology into place, deallocating old one - DEALLOCATE( topology ) CALL move_alloc( new_topology, topology ) END IF @@ -779,9 +694,9 @@ SUBROUTINE squash_topology( topology, control, st ) END SUBROUTINE squash_topology -!-*-*- G A L A H A D - S S I D S _ analyse_coord S U B R O U T I N E -*-*- +!-*-*- G A L A H A D - S L B L T _ analyse_coord S U B R O U T I N E -*-*- - SUBROUTINE ssids_analyse_coord_precision( n, ne, row, col, akeep, control, & + SUBROUTINE slblt_analyse_coord_precision( n, ne, row, col, akeep, control, & inform, order, val, topology ) ! analyse phase: matrix entered in coordinate format. @@ -799,15 +714,15 @@ SUBROUTINE ssids_analyse_coord_precision( n, ne, row, col, akeep, control, & ! see derived-type declaration - TYPE( SSIDS_akeep_type ), INTENT( INOUT ) :: akeep + TYPE( SLBLT_akeep_type ), INTENT( INOUT ) :: akeep ! see derived-type declaration - TYPE( SSIDS_control_type ), INTENT( IN ) :: control + TYPE( SLBLT_control_type ), INTENT( IN ) :: control ! see derived-type declaration - TYPE( SSIDS_inform_type ), INTENT( OUT ) :: inform + TYPE( SLBLT_inform_type ), INTENT( OUT ) :: inform ! Must be present and set on entry if control%ordering = 0. If i is used to ! index a variable, order(i) must hold its position in the pivot sequence. @@ -824,7 +739,7 @@ SUBROUTINE ssids_analyse_coord_precision( n, ne, row, col, akeep, control, & ! user specified topology - TYPE( HW_numa_region ), DIMENSION( : ), OPTIONAL, INTENT( IN ) :: topology + TYPE( TOPOLOGY_numa_region ), DIMENSION( : ), OPTIONAL, INTENT( IN ) :: topology ! local variables @@ -852,20 +767,13 @@ SUBROUTINE ssids_analyse_coord_precision( n, ne, row, col, akeep, control, & ! INTEGER( KIND = ip_ ) :: flag ! error flag for metis INTEGER( KIND = ip_ ) :: st ! stat parameter INTEGER( KIND = ip_ ) :: free_flag - TYPE( ssids_inform_type ) :: inform_default + TYPE( slblt_inform_type ) :: inform_default ! initialise - context = 'ssids_analyse_coord' + context = 'slblt_analyse_coord' inform = inform_default - CALL ssids_free( akeep, free_flag ) -! IF ( free_flag /= 0 ) THEN -! inform%flag = SSIDS_ERROR_CUDA_UNKNOWN -! inform%cuda_error = free_flag -! akeep%inform = inform -! CALL inform%print_flag( control, context ) -! RETURN -! END IF + CALL slblt_free( akeep, free_flag ) ! output status on entry @@ -883,7 +791,7 @@ SUBROUTINE ssids_analyse_coord_precision( n, ne, row, col, akeep, control, & ! checking of matrix data IF ( n < 0 .OR. ne < 0 ) THEN - inform%flag = SSIDS_ERROR_A_N_OOR + inform%flag = SLBLT_ERROR_A_N_OOR akeep%inform = inform CALL inform%print_flag( control, context ) RETURN @@ -903,7 +811,7 @@ SUBROUTINE ssids_analyse_coord_precision( n, ne, row, col, akeep, control, & ! check control%ordering has a valid value IF ( control%ordering < 0 .OR. control%ordering > 2 ) THEN - inform%flag = SSIDS_ERROR_ORDER + inform%flag = SLBLT_ERROR_ORDER akeep%inform = inform CALL inform%print_flag( control, context ) RETURN @@ -913,7 +821,7 @@ SUBROUTINE ssids_analyse_coord_precision( n, ne, row, col, akeep, control, & IF ( control%ordering == 2 ) THEN IF ( .NOT. PRESENT( val ) ) THEN - inform%flag = SSIDS_ERROR_VAL + inform%flag = SLBLT_ERROR_VAL akeep%inform = inform CALL inform%print_flag( control, context ) RETURN @@ -925,14 +833,14 @@ SUBROUTINE ssids_analyse_coord_precision( n, ne, row, col, akeep, control, & IF ( st /= 0 ) GO TO 490 IF ( PRESENT( val ) ) THEN - CALL MU_convert_coord_to_cscl( SSIDS_MATRIX_REAL_SYM_INDEF, n, n, ne, & + CALL MU_convert_coord_to_cscl( SLBLT_MATRIX_REAL_SYM_INDEF, n, n, ne, & row, col, akeep%ptr, akeep%row, mu_flag, & val_in = val, val_out = val_clean, & lmap = akeep%lmap, map = akeep%map, & noor = inform%matrix_outrange, & ndup = inform%matrix_dup ) ELSE - CALL MU_convert_coord_to_cscl( SSIDS_MATRIX_REAL_SYM_INDEF, n, n, ne, & + CALL MU_convert_coord_to_cscl( SLBLT_MATRIX_REAL_SYM_INDEF, n, n, ne, & row, col, akeep%ptr, akeep%row, mu_flag, & lmap = akeep%lmap, map = akeep%map, & noor = inform%matrix_outrange, & @@ -942,8 +850,8 @@ SUBROUTINE ssids_analyse_coord_precision( n, ne, row, col, akeep, control, & ! check for errors IF ( mu_flag < 0 ) THEN - IF ( mu_flag == - 1 ) inform%flag = SSIDS_ERROR_ALLOCATION - IF ( mu_flag == - 10 ) inform%flag = SSIDS_ERROR_A_ALL_OOR + IF ( mu_flag == - 1 ) inform%flag = SLBLT_ERROR_ALLOCATION + IF ( mu_flag == - 10 ) inform%flag = SLBLT_ERROR_A_ALL_OOR akeep%inform = inform CALL inform%print_flag( control, context ) RETURN @@ -974,7 +882,7 @@ SUBROUTINE ssids_analyse_coord_precision( n, ne, row, col, akeep, control, & ! raise an error if the user claims but fails to supply the order IF ( .NOT. PRESENT( order ) ) THEN - inform%flag = SSIDS_ERROR_ORDER + inform%flag = SLBLT_ERROR_ORDER akeep%inform = inform CALL inform%print_flag( control, context ) RETURN @@ -1008,14 +916,14 @@ SUBROUTINE ssids_analyse_coord_precision( n, ne, row, col, akeep, control, & SELECT CASE( mo_flag ) CASE( 0 ) ! success; do nothing CASE( 1 ) ! singularity warning required - inform%flag = SSIDS_WARNING_ANALYSIS_SINGULAR + inform%flag = SLBLT_WARNING_ANALYSIS_SINGULAR CASE( - 1 ) - inform%flag = SSIDS_ERROR_ALLOCATION + inform%flag = SLBLT_ERROR_ALLOCATION akeep%inform = inform CALL inform%print_flag( control, context ) RETURN CASE DEFAULT - inform%flag = SSIDS_ERROR_UNKNOWN + inform%flag = SLBLT_ERROR_UNKNOWN akeep%inform = inform CALL inform%print_flag( control, context ) RETURN @@ -1034,7 +942,7 @@ SUBROUTINE ssids_analyse_coord_precision( n, ne, row, col, akeep, control, & ! guess it ELSE - CALL HW_guess_topology( akeep%topology, st ) + CALL TOPOLOGY_guess_topology( akeep%topology, st ) IF ( st /= 0 ) GO TO 490 END IF @@ -1051,16 +959,16 @@ SUBROUTINE ssids_analyse_coord_precision( n, ne, row, col, akeep, control, & 490 CONTINUE inform%stat = st - IF ( inform%stat /= 0 ) inform%flag = SSIDS_ERROR_ALLOCATION + IF ( inform%stat /= 0 ) inform%flag = SLBLT_ERROR_ALLOCATION akeep%inform = inform CALL inform%print_flag( control, context ) RETURN - END SUBROUTINE ssids_analyse_coord_precision + END SUBROUTINE slblt_analyse_coord_precision -!-*-*- G A L A H A D - S S I D S _ factor_ptr32 S U B R O U T I N E -*-*- +!-*-*- G A L A H A D - S L B L T _ factor_ptr32 S U B R O U T I N E -*-*- - SUBROUTINE ssids_factor_ptr32_precision( posdef, val, akeep, fkeep, & + SUBROUTINE slblt_factor_ptr32_precision( posdef, val, akeep, fkeep, & control, inform, scale, ptr, row ) ! factorize phase: 32-bit wrapper around 64-bit version, NB ptr is non-OPTIONAL @@ -1068,10 +976,10 @@ SUBROUTINE ssids_factor_ptr32_precision( posdef, val, akeep, fkeep, & IMPLICIT NONE LOGICAL, INTENT( IN ) :: posdef REAL( KIND = rp_ ), DIMENSION( * ), target, INTENT( IN ) :: val - TYPE( SSIDS_akeep_type ), INTENT( IN ) :: akeep - TYPE( SSIDS_fkeep_type ), INTENT( INOUT ) :: fkeep - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( OUT ) :: inform + TYPE( SLBLT_akeep_type ), INTENT( IN ) :: akeep + TYPE( SLBLT_fkeep_type ), INTENT( INOUT ) :: fkeep + TYPE( SLBLT_control_type ), INTENT( IN ) :: control + TYPE( SLBLT_inform_type ), INTENT( OUT ) :: inform REAL( KIND = rp_ ), DIMENSION( : ), OPTIONAL, INTENT( INOUT ) :: scale INTEGER( KIND = i4_ ), DIMENSION( akeep%n + 1 ), INTENT( IN ) :: ptr INTEGER( KIND = ip_ ), DIMENSION( * ), OPTIONAL, INTENT( IN ) :: row @@ -1084,8 +992,8 @@ SUBROUTINE ssids_factor_ptr32_precision( posdef, val, akeep, fkeep, & ALLOCATE( ptr64( akeep%n + 1 ), stat=inform%stat ) IF ( inform%stat /= 0 ) THEN - inform%flag = SSIDS_ERROR_ALLOCATION - CALL inform%print_flag( control, 'ssids_factor' ) + inform%flag = SLBLT_ERROR_ALLOCATION + CALL inform%print_flag( control, 'slblt_factor' ) fkeep%inform = inform RETURN END IF @@ -1093,16 +1001,16 @@ SUBROUTINE ssids_factor_ptr32_precision( posdef, val, akeep, fkeep, & ! call 64-bit routine - CALL ssids_factor_ptr64_precision( posdef, val, akeep, fkeep, control, & + CALL slblt_factor_ptr64_precision( posdef, val, akeep, fkeep, control, & inform, scale = scale, ptr = ptr64, & row = row ) RETURN - END SUBROUTINE ssids_factor_ptr32_precision + END SUBROUTINE slblt_factor_ptr32_precision -!-*-*- G A L A H A D - S S I D S _ factor_ptr64 S U B R O U T I N E -*-*- +!-*-*- G A L A H A D - S L B L T _ factor_ptr64 S U B R O U T I N E -*-*- - SUBROUTINE ssids_factor_ptr64_precision( posdef, val, akeep, fkeep, & + SUBROUTINE slblt_factor_ptr64_precision( posdef, val, akeep, fkeep, & control, inform, scale, ptr, row ) ! factorize phase (64-bit pointers) @@ -1113,10 +1021,10 @@ SUBROUTINE ssids_factor_ptr64_precision( posdef, val, akeep, fkeep, & ! A values (lower triangle) REAL( KIND = rp_ ), DIMENSION( * ), target, INTENT( IN ) :: val - TYPE( SSIDS_akeep_type ), INTENT( IN ) :: akeep - TYPE( SSIDS_fkeep_type ), INTENT( INOUT ) :: fkeep - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( OUT ) :: inform + TYPE( SLBLT_akeep_type ), INTENT( IN ) :: akeep + TYPE( SLBLT_fkeep_type ), INTENT( INOUT ) :: fkeep + TYPE( SLBLT_control_type ), INTENT( IN ) :: control + TYPE( SLBLT_inform_type ), INTENT( OUT ) :: inform ! used to hold row and column scaling factors. Must be set on entry if ! control%scaling <= 0. Note: has to be assumed shape, not assumed size @@ -1162,7 +1070,7 @@ SUBROUTINE ssids_factor_ptr64_precision( posdef, val, akeep, fkeep, & ! setup for any printing we may require - context = 'ssids_factor' + context = 'slblt_factor' ! print summary of input control (depending on print level etc) @@ -1171,7 +1079,7 @@ SUBROUTINE ssids_factor_ptr64_precision( posdef, val, akeep, fkeep, & ! check for error in call sequence, specfically if analyse cannot has been run IF ( .NOT. ALLOCATED( akeep%sptr ) .OR. akeep%inform%flag < 0 ) THEN - inform%flag = SSIDS_ERROR_CALL_SEQUENCE + inform%flag = SLBLT_ERROR_CALL_SEQUENCE CALL inform%print_flag( control, context ) fkeep%inform = inform RETURN @@ -1197,23 +1105,23 @@ SUBROUTINE ssids_factor_ptr64_precision( posdef, val, akeep, fkeep, & ! immediate return if analyse detected singularity and control%action=false IF ( .NOT. control%action .AND. akeep%n /= akeep%inform%matrix_rank ) THEN - inform%flag = SSIDS_ERROR_SINGULAR + inform%flag = SLBLT_ERROR_SINGULAR GO TO 100 END IF ! immediate return for trivial matrix IF ( akeep%nnodes == 0 ) THEN - inform%flag = SSIDS_SUCCESS + inform%flag = SLBLT_SUCCESS inform%matrix_rank = 0 GO TO 100 END IF fkeep%pos_def = posdef IF ( posdef ) THEN - matrix_type = SSIDS_MATRIX_REAL_SYM_PSDEF + matrix_type = SLBLT_MATRIX_REAL_SYM_PSDEF ELSE - matrix_type = SSIDS_MATRIX_REAL_SYM_INDEF + matrix_type = SLBLT_MATRIX_REAL_SYM_INDEF END IF ! if matrix has been checked, produce a clean version of val in val2 @@ -1228,8 +1136,8 @@ SUBROUTINE ssids_factor_ptr64_precision( posdef, val, akeep, fkeep, & ! analyse run with no checking so must have ptr and row present - IF ( .NOT. PRESENT( ptr ) ) inform%flag = SSIDS_ERROR_PTR_ROW - IF ( .NOT. PRESENT( row ) ) inform%flag = SSIDS_ERROR_PTR_ROW + IF ( .NOT. PRESENT( ptr ) ) inform%flag = SLBLT_ERROR_PTR_ROW + IF ( .NOT. PRESENT( row ) ) inform%flag = SLBLT_ERROR_PTR_ROW IF ( inform%flag < 0 ) THEN fkeep%inform = inform GO TO 100 @@ -1243,14 +1151,14 @@ SUBROUTINE ssids_factor_ptr64_precision( posdef, val, akeep, fkeep, & WRITE( control%unit_warning, * ) & "Dumping matrix to '", control%rb_dump, "'" IF ( akeep%check ) THEN - CALL RB_write( control%rb_dump, SSIDS_MATRIX_REAL_SYM_INDEF, n, n, & + CALL RB_write( control%rb_dump, SLBLT_MATRIX_REAL_SYM_INDEF, n, n, & akeep%ptr, akeep%row, rb_control, flag, val = val2 ) ELSE - CALL RB_write( control%rb_dump, SSIDS_MATRIX_REAL_SYM_INDEF, n, n, & + CALL RB_write( control%rb_dump, SLBLT_MATRIX_REAL_SYM_INDEF, n, n, & ptr, row, rb_control, flag, val = val ) END IF IF ( flag /= 0 ) THEN - inform%flag = SSIDS_ERROR_UNKNOWN + inform%flag = SLBLT_ERROR_UNKNOWN GO TO 100 END IF END IF @@ -1272,7 +1180,7 @@ SUBROUTINE ssids_factor_ptr64_precision( posdef, val, akeep, fkeep, & END IF IF ( ALLOCATED( akeep%scaling ) .AND. control%scaling /= 3 ) THEN - inform%flag = SSIDS_WARNING_MATCH_ORD_NO_SCALE + inform%flag = SLBLT_WARNING_MATCH_ORD_NO_SCALE CALL inform%print_flag( control, context ) END IF @@ -1308,7 +1216,7 @@ SUBROUTINE ssids_factor_ptr64_precision( posdef, val, akeep, fkeep, & st = hsinform%stat GO TO 10 CASE( - 2 ) ! Structually singular matrix and control%action=.false. - inform%flag = SSIDS_ERROR_SINGULAR + inform%flag = SLBLT_ERROR_SINGULAR GO TO 100 END SELECT @@ -1370,7 +1278,7 @@ SUBROUTINE ssids_factor_ptr64_precision( posdef, val, akeep, fkeep, & ! no scaling saved from analyse phase IF ( .NOT. ALLOCATED( akeep%scaling ) ) THEN - inform%flag = SSIDS_ERROR_NO_SAVED_SCALING + inform%flag = SLBLT_ERROR_NO_SAVED_SCALING GO TO 100 END IF DO i = 1, n @@ -1455,9 +1363,9 @@ SUBROUTINE ssids_factor_ptr64_precision( posdef, val, akeep, fkeep, & ! rank deficient, if we reach this point then must be control%action=.true. IF ( control%action ) THEN - inform%flag = SSIDS_WARNING_FACT_SINGULAR + inform%flag = SLBLT_WARNING_FACT_SINGULAR ELSE - inform%flag = SSIDS_ERROR_SINGULAR + inform%flag = SLBLT_ERROR_SINGULAR END IF CALL inform%print_flag( control, context ) END IF @@ -1504,15 +1412,15 @@ SUBROUTINE ssids_factor_ptr64_precision( posdef, val, akeep, fkeep, & ! error handling 10 CONTINUE - inform%flag = SSIDS_ERROR_ALLOCATION + inform%flag = SLBLT_ERROR_ALLOCATION inform%stat = st GO TO 100 - END SUBROUTINE ssids_factor_ptr64_precision + END SUBROUTINE slblt_factor_ptr64_precision -!-*-*- G A L A H A D - S S I D S _ s o l v e _ o n e S U B R O U T I N E -*- +!-*-*- G A L A H A D - S L B L T _ s o l v e _ o n e S U B R O U T I N E -*- - SUBROUTINE ssids_solve_one_precision( x1, akeep, fkeep, control, inform, & + SUBROUTINE slblt_solve_one_precision( x1, akeep, fkeep, control, inform, & job ) ! solve phase single x @@ -1524,10 +1432,10 @@ SUBROUTINE ssids_solve_one_precision( x1, akeep, fkeep, control, inform, & ! has been used to index a variable, x(i) holds solution for variable i REAL( KIND = rp_ ), DIMENSION( : ), INTENT( INOUT ) :: x1 - TYPE( SSIDS_akeep_type ), INTENT( IN ) :: akeep - TYPE( SSIDS_fkeep_type ), INTENT( INOUT ) :: fkeep - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( OUT ) :: inform + TYPE( SLBLT_akeep_type ), INTENT( IN ) :: akeep + TYPE( SLBLT_fkeep_type ), INTENT( INOUT ) :: fkeep + TYPE( SLBLT_control_type ), INTENT( IN ) :: control + TYPE( SLBLT_inform_type ), INTENT( OUT ) :: inform INTEGER( KIND = ip_ ), OPTIONAL, INTENT( IN ) :: job ! local variables @@ -1536,19 +1444,19 @@ SUBROUTINE ssids_solve_one_precision( x1, akeep, fkeep, control, inform, & ldx = SIZE( x1 ) IF ( PRESENT( job ) ) THEN - CALL ssids_solve_mult_precision( 1_ip_, x1, ldx, akeep, fkeep, control, & + CALL slblt_solve_mult_precision( 1_ip_, x1, ldx, akeep, fkeep, control, & inform, job ) ELSE - CALL ssids_solve_mult_precision( 1_ip_, x1, ldx, akeep, fkeep, control, & + CALL slblt_solve_mult_precision( 1_ip_, x1, ldx, akeep, fkeep, control, & inform ) END IF RETURN - END SUBROUTINE ssids_solve_one_precision + END SUBROUTINE slblt_solve_one_precision -!-*- G A L A H A D - S S I D S _ s o l v e _ m u l t S U B R O U T I N E -*- +!-*- G A L A H A D - S L B L T _ s o l v e _ m u l t S U B R O U T I N E -*- - SUBROUTINE ssids_solve_mult_precision( nrhs, x, ldx, akeep, fkeep, & + SUBROUTINE slblt_solve_mult_precision( nrhs, x, ldx, akeep, fkeep, & control, inform, job ) ! solve phase multiple x @@ -1563,13 +1471,13 @@ SUBROUTINE ssids_solve_mult_precision( nrhs, x, ldx, akeep, fkeep, & ! x( i,j ) holds solution for variable i to system j REAL( KIND = rp_ ), DIMENSION( ldx,nrhs ), INTENT( INOUT ), target :: x - TYPE( SSIDS_akeep_type ), INTENT( IN ) :: akeep + TYPE( SLBLT_akeep_type ), INTENT( IN ) :: akeep ! for details of keep, control, inform : see derived type description - TYPE( SSIDS_fkeep_type ), INTENT( INOUT ) :: fkeep !inout for moving data - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( OUT ) :: inform + TYPE( SLBLT_fkeep_type ), INTENT( INOUT ) :: fkeep !inout for moving data + TYPE( SLBLT_control_type ), INTENT( IN ) :: control + TYPE( SLBLT_inform_type ), INTENT( OUT ) :: inform ! job is used to indicate whether a partial solution required ! job = 1 : forward eliminations only (PLX = B) @@ -1586,14 +1494,14 @@ SUBROUTINE ssids_solve_mult_precision( nrhs, x, ldx, akeep, fkeep, & INTEGER( KIND = ip_ ) :: local_job ! local job parameter INTEGER( KIND = ip_ ) :: n - context = 'ssids_solve' - inform%flag = SSIDS_SUCCESS + context = 'slblt_solve' + inform%flag = SLBLT_SUCCESS ! perform appropriate printing IF ( control%print_level >= 1 .AND. control%unit_diagnostics >= 0 ) THEN WRITE( control%unit_diagnostics,'( //a )' ) & - ' Entering ssids_solve with:' + ' Entering slblt_solve with:' WRITE( control%unit_diagnostics, '( A, 4( / A, I12 ),( / A, I12 ) )' ) & ' control parameters ( control% ) :', & ' print_level Level of diagnostic printing = ', & @@ -1614,24 +1522,24 @@ SUBROUTINE ssids_solve_mult_precision( nrhs, x, ldx, akeep, fkeep, & ! factorize phase has not been performed IF ( .NOT. ALLOCATED( fkeep%subtree ) ) THEN - inform%flag = SSIDS_ERROR_CALL_SEQUENCE + inform%flag = SLBLT_ERROR_CALL_SEQUENCE CALL inform%print_flag( control, context ) RETURN END IF - inform%flag = MAX( SSIDS_SUCCESS, fkeep%inform%flag ) ! Preserve warnings + inform%flag = MAX( SLBLT_SUCCESS, fkeep%inform%flag ) ! Preserve warnings ! immediate return if already had an error IF ( akeep%inform%flag < 0 .OR. fkeep%inform%flag < 0 ) THEN - inform%flag = SSIDS_ERROR_CALL_SEQUENCE + inform%flag = SLBLT_ERROR_CALL_SEQUENCE CALL inform%print_flag( control, context ) RETURN END IF n = akeep%n IF ( ldx < n ) THEN - inform%flag = SSIDS_ERROR_X_SIZE + inform%flag = SLBLT_ERROR_X_SIZE CALL inform%print_flag( control, context ) IF ( control%print_level >= 0 .AND. control%unit_error > 0 ) & WRITE( control%unit_error,'( A, I8, A, I8 )' ) & @@ -1640,7 +1548,7 @@ SUBROUTINE ssids_solve_mult_precision( nrhs, x, ldx, akeep, fkeep, & END IF IF ( nrhs < 1 ) THEN - inform%flag = SSIDS_ERROR_X_SIZE + inform%flag = SLBLT_ERROR_X_SIZE CALL inform%print_flag( control, context ) IF ( control%print_level >= 0 .AND. control%unit_error > 0 ) & WRITE ( control%unit_error, '( A, I8, A, I8 )' ) & @@ -1656,13 +1564,13 @@ SUBROUTINE ssids_solve_mult_precision( nrhs, x, ldx, akeep, fkeep, & local_job = 0 IF ( PRESENT( job ) ) THEN - IF ( job < SSIDS_SOLVE_JOB_FWD .OR. job > SSIDS_SOLVE_JOB_DIAG_BWD ) & - inform%flag = SSIDS_ERROR_JOB_OOR - IF ( fkeep%pos_def .AND. job == SSIDS_SOLVE_JOB_DIAG ) & - inform%flag = SSIDS_ERROR_JOB_OOR - IF ( fkeep%pos_def .AND. job == SSIDS_SOLVE_JOB_DIAG_BWD ) & - inform%flag = SSIDS_ERROR_JOB_OOR - IF ( inform%flag == SSIDS_ERROR_JOB_OOR ) THEN + IF ( job < SLBLT_SOLVE_JOB_FWD .OR. job > SLBLT_SOLVE_JOB_DIAG_BWD ) & + inform%flag = SLBLT_ERROR_JOB_OOR + IF ( fkeep%pos_def .AND. job == SLBLT_SOLVE_JOB_DIAG ) & + inform%flag = SLBLT_ERROR_JOB_OOR + IF ( fkeep%pos_def .AND. job == SLBLT_SOLVE_JOB_DIAG_BWD ) & + inform%flag = SLBLT_ERROR_JOB_OOR + IF ( inform%flag == SLBLT_ERROR_JOB_OOR ) THEN CALL inform%print_flag( control, context ) RETURN END IF @@ -1673,33 +1581,33 @@ SUBROUTINE ssids_solve_mult_precision( nrhs, x, ldx, akeep, fkeep, & CALL inform%print_flag( control, context ) RETURN - END SUBROUTINE ssids_solve_mult_precision + END SUBROUTINE slblt_solve_mult_precision -!-*-*- G A L A H A D - S S I D S _ enquire_posdef S U B R O U T I N E -*-*- +!-*-*- G A L A H A D - S L B L T _ enquire_posdef S U B R O U T I N E -*-*- - SUBROUTINE ssids_enquire_posdef_precision( akeep, fkeep, control, & + SUBROUTINE slblt_enquire_posdef_precision( akeep, fkeep, control, & inform, d ) ! return diagonal entries to user IMPLICIT NONE - TYPE( SSIDS_akeep_type ), INTENT( IN ) :: akeep - TYPE( SSIDS_fkeep_type ), target, INTENT( IN ) :: fkeep - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( OUT ) :: inform + TYPE( SLBLT_akeep_type ), INTENT( IN ) :: akeep + TYPE( SLBLT_fkeep_type ), target, INTENT( IN ) :: fkeep + TYPE( SLBLT_control_type ), INTENT( IN ) :: control + TYPE( SLBLT_inform_type ), INTENT( OUT ) :: inform REAL( KIND = rp_ ), DIMENSION( * ), INTENT( OUT ) :: d ! local variables CHARACTER( LEN = 50 ) :: context ! procedure name ( used when printing ) - context = 'ssids_enquire_posdef' - inform%flag = SSIDS_SUCCESS + context = 'slblt_enquire_posdef' + inform%flag = SLBLT_SUCCESS ! factorize phase has not been performed IF ( .NOT. ALLOCATED( fkeep%subtree ) ) THEN - inform%flag = SSIDS_ERROR_CALL_SEQUENCE + inform%flag = SLBLT_ERROR_CALL_SEQUENCE CALL inform%print_flag( control, context ) RETURN END IF @@ -1707,13 +1615,13 @@ SUBROUTINE ssids_enquire_posdef_precision( akeep, fkeep, control, & ! immediate return if there had already been an error IF ( akeep%inform%flag < 0 .OR. fkeep%inform%flag < 0 ) THEN - inform%flag = SSIDS_ERROR_CALL_SEQUENCE + inform%flag = SLBLT_ERROR_CALL_SEQUENCE CALL inform%print_flag( control, context ) RETURN END IF IF ( .NOT. fkeep%pos_def ) THEN - inform%flag = SSIDS_ERROR_NOT_LLT + inform%flag = SLBLT_ERROR_NOT_LLT CALL inform%print_flag( control, context ) RETURN END IF @@ -1722,23 +1630,23 @@ SUBROUTINE ssids_enquire_posdef_precision( akeep, fkeep, control, & CALL inform%print_flag( control, context ) RETURN - END SUBROUTINE ssids_enquire_posdef_precision + END SUBROUTINE slblt_enquire_posdef_precision -!-*-*- G A L A H A D - S S I D S _ enquire_indef S U B R O U T I N E -*-*- +!-*-*- G A L A H A D - S L B L T _ enquire_indef S U B R O U T I N E -*-*- - SUBROUTINE ssids_enquire_indef_precision( akeep, fkeep, control, inform, & + SUBROUTINE slblt_enquire_indef_precision( akeep, fkeep, control, inform, & piv_order, d ) ! In the indefinite case, the pivot sequence used will not necessarily be -! the same as that passed to ssids_factor ( because of delayed pivots ). +! the same as that passed to slblt_factor ( because of delayed pivots ). ! This SUBROUTINE allows the user to obtain the pivot sequence that was ! actually used. also the entries of D^{-1} are RETURNed using array d. IMPLICIT NONE - TYPE( SSIDS_akeep_type ), INTENT( IN ) :: akeep - TYPE( SSIDS_fkeep_type ), target, INTENT( IN ) :: fkeep - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( OUT ) :: inform + TYPE( SLBLT_akeep_type ), INTENT( IN ) :: akeep + TYPE( SLBLT_fkeep_type ), target, INTENT( IN ) :: fkeep + TYPE( SLBLT_control_type ), INTENT( IN ) :: control + TYPE( SLBLT_inform_type ), INTENT( OUT ) :: inform ! if i is used to index a variable, its position in the pivot sequence ! will be placed in piv_order(i), with its sign negative if it is @@ -1756,13 +1664,13 @@ SUBROUTINE ssids_enquire_indef_precision( akeep, fkeep, control, inform, & CHARACTER( LEN = 50 ) :: context ! Procedure name ( used when printing ). INTEGER( KIND = ip_ ) :: i, po - context = 'ssids_enquire_indef' - inform%flag = SSIDS_SUCCESS + context = 'slblt_enquire_indef' + inform%flag = SLBLT_SUCCESS ! check if factorize phase has been performed IF ( .NOT. ALLOCATED( fkeep%subtree ) ) THEN - inform%flag = SSIDS_ERROR_CALL_SEQUENCE + inform%flag = SLBLT_ERROR_CALL_SEQUENCE CALL inform%print_flag( control, context ) RETURN END IF @@ -1770,13 +1678,13 @@ SUBROUTINE ssids_enquire_indef_precision( akeep, fkeep, control, inform, & ! immediate return if there has been an error IF ( akeep%inform%flag < 0 .OR. fkeep%inform%flag < 0 ) THEN - inform%flag = SSIDS_ERROR_CALL_SEQUENCE + inform%flag = SLBLT_ERROR_CALL_SEQUENCE CALL inform%print_flag( control, context ) RETURN END IF IF ( fkeep%pos_def ) THEN - inform%flag = SSIDS_ERROR_NOT_LDLT + inform%flag = SLBLT_ERROR_NOT_LDLT CALL inform%print_flag( control, context ) RETURN END IF @@ -1786,7 +1694,7 @@ SUBROUTINE ssids_enquire_indef_precision( akeep, fkeep, control, inform, & ! bug fix to give 1-based indices IF ( PRESENT( piv_order ) ) THEN -! WRITE( 6,"( ' ssids: piv_order ', 7I6 )" ) piv_order( : akeep%n ) +! WRITE( 6,"( ' slblt: piv_order ', 7I6 )" ) piv_order( : akeep%n ) ! bug fix to determine what a C 0 index means @@ -1809,16 +1717,16 @@ SUBROUTINE ssids_enquire_indef_precision( akeep, fkeep, control, inform, & END IF END DO END IF -! WRITE( 6,"( ' ssids: revised piv_order ', 7I6 )" ) piv_order( : akeep%n ) +! WRITE( 6,"( ' slblt: revised piv_order ', 7I6 )" ) piv_order( : akeep%n ) END IF CALL inform%print_flag( control, context ) RETURN - END SUBROUTINE ssids_enquire_indef_precision + END SUBROUTINE slblt_enquire_indef_precision -!-*-*-*- G A L A H A D - S S I D S _ a l t e r S U B R O U T I N E -*-*-*- +!-*-*-*- G A L A H A D - S L B L T _ a l t e r S U B R O U T I N E -*-*-*- - SUBROUTINE ssids_alter_precision( d, akeep, fkeep, control, inform ) + SUBROUTINE slblt_alter_precision( d, akeep, fkeep, control, inform ) ! in the indefinite case, change the entries of D^{-1} @@ -1828,22 +1736,22 @@ SUBROUTINE ssids_alter_precision( d, akeep, fkeep, control, inform ) ! and the off-diagonal entries must be placed in d(2,i) (i = 1,...n-1) REAL( KIND = rp_ ), DIMENSION( 2, * ), INTENT( IN ) :: d - TYPE( SSIDS_akeep_type ), INTENT( IN ) :: akeep - TYPE( SSIDS_fkeep_type ), target, INTENT( INOUT ) :: fkeep - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( OUT ) :: inform + TYPE( SLBLT_akeep_type ), INTENT( IN ) :: akeep + TYPE( SLBLT_fkeep_type ), target, INTENT( INOUT ) :: fkeep + TYPE( SLBLT_control_type ), INTENT( IN ) :: control + TYPE( SLBLT_inform_type ), INTENT( OUT ) :: inform ! local variables CHARACTER( LEN = 50 ) :: context ! procedure name (used when printing) - context = 'ssids_alter' - inform%flag = SSIDS_SUCCESS + context = 'slblt_alter' + inform%flag = SLBLT_SUCCESS ! factorize phase has not been performed IF ( .NOT. ALLOCATED( fkeep%subtree ) ) THEN - inform%flag = SSIDS_ERROR_CALL_SEQUENCE + inform%flag = SLBLT_ERROR_CALL_SEQUENCE CALL inform%print_flag( control, context ) RETURN END IF @@ -1851,13 +1759,13 @@ SUBROUTINE ssids_alter_precision( d, akeep, fkeep, control, inform ) ! immediate return if there had been already an error IF ( akeep%inform%flag < 0 .OR. fkeep%inform%flag < 0 ) THEN - inform%flag = SSIDS_ERROR_CALL_SEQUENCE + inform%flag = SLBLT_ERROR_CALL_SEQUENCE CALL inform%print_flag( control, context ) RETURN END IF IF ( fkeep%pos_def ) THEN - inform%flag = SSIDS_ERROR_NOT_LDLT + inform%flag = SLBLT_ERROR_NOT_LDLT CALL inform%print_flag( control, context ) RETURN END IF @@ -1866,13 +1774,13 @@ SUBROUTINE ssids_alter_precision( d, akeep, fkeep, control, inform ) CALL inform%print_flag( control, context ) RETURN - END SUBROUTINE ssids_alter_precision + END SUBROUTINE slblt_alter_precision -!-*-*- G A L A H A D - S S I D S _ f r e e _a k e e p S U B R O U T I N E -*- +!-*-*- G A L A H A D - S L B L T _ f r e e _a k e e p S U B R O U T I N E -*- SUBROUTINE free_akeep_precision( akeep, flag ) IMPLICIT NONE - TYPE( SSIDS_akeep_type ), INTENT( INOUT ) :: akeep + TYPE( SLBLT_akeep_type ), INTENT( INOUT ) :: akeep INTEGER( KIND = ip_ ), INTENT( OUT ) :: flag CALL akeep%free( flag ) @@ -1880,36 +1788,36 @@ SUBROUTINE free_akeep_precision( akeep, flag ) END SUBROUTINE free_akeep_precision -!-*-*- G A L A H A D - S S I D S _ f r e e _f k e e p S U B R O U T I N E -*- +!-*-*- G A L A H A D - S L B L T _ f r e e _f k e e p S U B R O U T I N E -*- - SUBROUTINE free_fkeep_precision( fkeep, cuda_error ) + SUBROUTINE free_fkeep_precision( fkeep, flag ) IMPLICIT NONE - TYPE( SSIDS_fkeep_type ), INTENT( INOUT ) :: fkeep - INTEGER( KIND = ip_ ), INTENT( OUT ) :: cuda_error + TYPE( SLBLT_fkeep_type ), INTENT( INOUT ) :: fkeep + INTEGER( KIND = ip_ ), INTENT( OUT ) :: flag - CALL fkeep%free( cuda_error ) + CALL fkeep%free( flag ) RETURN END SUBROUTINE free_fkeep_precision -!-*-*- G A L A H A D - S S I D S _ f r e e _ b o t h S U B R O U T I N E -*- +!-*-*- G A L A H A D - S L B L T _ f r e e _ b o t h S U B R O U T I N E -*- - SUBROUTINE free_both_precision( akeep, fkeep, cuda_error ) + SUBROUTINE free_both_precision( akeep, fkeep, flag ) IMPLICIT NONE - TYPE( SSIDS_akeep_type ), INTENT( INOUT ) :: akeep - TYPE( SSIDS_fkeep_type ), INTENT( INOUT ) :: fkeep - INTEGER( KIND = ip_ ), INTENT( OUT ) :: cuda_error + TYPE( SLBLT_akeep_type ), INTENT( INOUT ) :: akeep + TYPE( SLBLT_fkeep_type ), INTENT( INOUT ) :: fkeep + INTEGER( KIND = ip_ ), INTENT( OUT ) :: flag ! must free fkeep first as it may reference akeep - CALL free_fkeep_precision( fkeep, cuda_error ) - IF ( cuda_error /= 0 ) RETURN - CALL free_akeep_precision( akeep, cuda_error ) + CALL free_fkeep_precision( fkeep, flag ) + IF ( flag /= 0 ) RETURN + CALL free_akeep_precision( akeep, flag ) RETURN END SUBROUTINE free_both_precision -!-*-*- G A L A H A D - S S I D S _ push_omp_settings S U B R O U T I N E -*-*- +!-*-*- G A L A H A D - S L B L T _ push_omp_settings S U B R O U T I N E -*-*- SUBROUTINE push_omp_settings( user_settings, flag ) @@ -1930,13 +1838,13 @@ SUBROUTINE push_omp_settings( user_settings, flag ) !$ ! issue an error if we don't have cancellation ( could lead to segfaults ) !$ IF ( .NOT. omp_get_cancellation( ) ) THEN -!$ flag = SSIDS_ERROR_OMP_CANCELLATION +!$ flag = SLBLT_ERROR_OMP_CANCELLATION !$ RETURN !$ END IF !$ ! issue a warning if proc_bind is not enabled !$ IF ( omp_get_proc_bind( ) == OMP_PROC_BIND_FALSE ) & -!$ flag = SSIDS_WARNING_OMP_PROC_BIND +!$ flag = SLBLT_WARNING_OMP_PROC_BIND !!$ ! must have nested enabled !!$ user_settings%nested = omp_get_nested( ) @@ -1953,7 +1861,7 @@ SUBROUTINE push_omp_settings( user_settings, flag ) END SUBROUTINE push_omp_settings -!-*-*- G A L A H A D - S S I D S _ pop_omp_settings S U B R O U T I N E -*-*- +!-*-*- G A L A H A D - S L B L T _ pop_omp_settings S U B R O U T I N E -*-*- SUBROUTINE pop_omp_settings( user_settings ) @@ -1971,10 +1879,10 @@ SUBROUTINE pop_omp_settings( user_settings ) END SUBROUTINE pop_omp_settings ! ============================================================================ -! =================== extracted from SSIDS_ANALYSE module ==================== +! =================== extracted from SLBLT_ANALYSE module ==================== ! ============================================================================ -!- G A L A H A D - S S I D S _ a n a l y s e _ p h a s e S U B R O U T I N E - +!- G A L A H A D - S L B L T _ a n a l y s e _ p h a s e S U B R O U T I N E - SUBROUTINE analyse_phase( n, ptr, row, ptr2, row2, order, invp, & akeep, control, inform ) @@ -2014,15 +1922,15 @@ SUBROUTINE analyse_phase( n, ptr, row, ptr2, row2, order, invp, & ! is NOT set to inverse for the final order that is returned. INTEGER( ip_ ), DIMENSION( n ), INTENT( OUT ) :: invp - TYPE( SSIDS_akeep_type ), INTENT( INOUT ) :: akeep - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( INOUT ) :: inform + TYPE( SLBLT_akeep_type ), INTENT( INOUT ) :: akeep + TYPE( SLBLT_control_type ), INTENT( IN ) :: control + TYPE( SLBLT_inform_type ), INTENT( INOUT ) :: inform CHARACTER( 50 ) :: context ! Procedure name ( used when printing ). INTEGER( ip_ ), DIMENSION( : ), ALLOCATABLE :: contrib_dest, exec_loc, level INTEGER( ip_ ) :: to_launch - INTEGER( ip_ ) :: numa_region, device, thread_num + INTEGER( ip_ ) :: numa_region, thread_num INTEGER( ip_ ) :: nemin, flag INTEGER( ip_ ) :: blkm, blkn INTEGER( ip_ ) :: i, j @@ -2030,7 +1938,7 @@ SUBROUTINE analyse_phase( n, ptr, row, ptr2, row2, order, invp, & INTEGER( long_ ) :: nz ! ptr( n + 1 ) - 1 INTEGER( ip_ ) :: st - context = 'ssids_analyse' + context = 'slblt_analyse' nout = control%unit_error IF ( control%print_level < 0 ) nout = - 1 nout1 = control%unit_warning @@ -2049,13 +1957,13 @@ SUBROUTINE analyse_phase( n, ptr, row, ptr2, row2, order, invp, & inform%stat, inform%num_factor, inform%num_flops ) SELECT CASE( flag ) CASE( 0 ) ! do nothing - CASE( SSIDS_ERROR_ALLOCATION ) ! allocation error - inform%flag = SSIDS_ERROR_ALLOCATION + CASE( SLBLT_ERROR_ALLOCATION ) ! allocation error + inform%flag = SLBLT_ERROR_ALLOCATION RETURN - CASE( SSIDS_WARNING_ANALYSIS_SINGULAR ) ! zero row/column - inform%flag = SSIDS_WARNING_ANALYSIS_SINGULAR + CASE( SLBLT_WARNING_ANALYSIS_SINGULAR ) ! zero row/column + inform%flag = SLBLT_WARNING_ANALYSIS_SINGULAR CASE default ! should never reach here - inform%flag = SSIDS_ERROR_UNKNOWN + inform%flag = SLBLT_ERROR_UNKNOWN END SELECT ! set invp to hold inverse of order @@ -2087,9 +1995,6 @@ SUBROUTINE analyse_phase( n, ptr, row, ptr2, row2, order, invp, & DO i = 1, SIZE( akeep%topology ) WRITE ( control%unit_diagnostics, * ) & "Region ", i, " with ", akeep%topology( i )%nproc, " cores" - IF ( SIZE( akeep%topology( i )%gpus )>0 ) & - WRITE ( control%unit_diagnostics, * ) & - "---> gpus ", akeep%topology( i )%gpus END DO END IF CALL find_subtree_partition( akeep%nnodes, akeep%sptr, akeep%sparent, & @@ -2127,53 +2032,29 @@ SUBROUTINE analyse_phase( n, ptr, row, ptr2, row2, order, invp, & to_launch = SIZE( akeep%topology ) !$omp parallel proc_bind( spread ) num_threads( to_launch ) default( shared ) & -!$omp private( i, numa_region, device, thread_num ) +!$omp private( i, numa_region, thread_num ) thread_num = 0 !$ thread_num = omp_get_thread_num( ) numa_region = thread_num + 1 DO i = 1, akeep%nparts ! only initialize subtree if this is the correct region: note that -! an "all region" subtree with location -1 is initialised by region 0 +! an "all region" subtree with location -1 is initialised by region 1 IF ( exec_loc( i ) == - 1 ) THEN IF ( numa_region /= 1 ) CYCLE - device = 0 - ELSE IF ( ( MOD( ( exec_loc( i ) - 1 ), & - SIZE( akeep%topology ) ) + 1 ) /= numa_region ) THEN + ELSE IF ( exec_loc( i ) /= numa_region ) THEN CYCLE - ELSE - device = ( exec_loc( i ) - 1 ) / SIZE( akeep%topology ) END IF akeep%subtree( i )%exec_loc = exec_loc( i ) - IF ( device == 0 ) THEN ! CPU - -!print * , numa_region, "init cpu subtree ", i, akeep%part( i ), & -! akeep%part( i + 1 ) - 1 - - akeep%subtree( i )%ptr => construct_cpu_symbolic_subtree( akeep%n, & - akeep%part( i ), akeep%part( i + 1 ), akeep%sptr, akeep%sparent, & - akeep%rptr, akeep%rlist, akeep%nptr, akeep%nlist, & - contrib_dest( akeep%contrib_ptr( i ) : & - akeep%contrib_ptr( i + 1 ) - 1 ), control ) - - ELSE ! GPU - device = akeep%topology( numa_region )%gpus( device ) - -!print * , numa_region, "init gpu subtree ", i, akeep%part( i ), & -! akeep%part( i + 1 ) - 1, "device", device +! all subtrees run on CPU NUMA regions -! return a dummy GPU call in lieu of a proper implementation - - akeep%subtree( i )%ptr => NULL( ) - -! akeep%subtree( i )%ptr => construct_gpu_symbolic_subtree( device, & -! akeep%n, akeep%part( i ), akeep%part( i + 1 ), akeep%sptr, & -! akeep%sparent, akeep%rptr, akeep%rlist, akeep%nptr, & -! akeep%nlist, control ) -! akeep%subtree( i )%ptr => dummy - END IF + akeep%subtree( i )%ptr => construct_symbolic_subtree( & + akeep%n, akeep%part( i ), akeep%part( i + 1 ), akeep%sptr, & + akeep%sparent, akeep%rptr, akeep%rlist, akeep%nptr, akeep%nlist, & + contrib_dest( akeep%contrib_ptr( i ) : & + akeep%contrib_ptr( i + 1 ) - 1 ), control ) END DO !$omp end parallel @@ -2204,13 +2085,13 @@ SUBROUTINE analyse_phase( n, ptr, row, ptr2, row2, order, invp, & 100 CONTINUE inform%stat = st IF ( inform%stat /= 0 ) THEN - inform%flag = SSIDS_ERROR_ALLOCATION + inform%flag = SLBLT_ERROR_ALLOCATION END IF RETURN END SUBROUTINE analyse_phase -!-*- G A L A H A D - S S I D S _ c h e c k _ o r d e r S U B R O U T I N E -* +!-*- G A L A H A D - S L B L T _ c h e c k _ o r d e r S U B R O U T I N E -* SUBROUTINE check_order( n, order, invp, control, inform ) @@ -2236,22 +2117,22 @@ SUBROUTINE check_order( n, order, invp, control, inform ) ! Used to check order and then holds inverse of perm. - TYPE( ssids_control_type ), INTENT( IN ) :: control - TYPE( ssids_inform_type ), INTENT( INOUT ) :: inform + TYPE( slblt_control_type ), INTENT( IN ) :: control + TYPE( slblt_inform_type ), INTENT( INOUT ) :: inform character( 50 ) :: context ! Procedure name ( used when printing ). INTEGER( ip_ ) :: i, j INTEGER( ip_ ) :: nout ! stream for error messages - context = 'ssids_analyse' + context = 'slblt_analyse' nout = control%unit_error IF ( control%print_level < 0 ) nout = - 1 ! order is too short IF ( SIZE( order ) < n ) THEN - inform%flag = SSIDS_ERROR_ORDER + inform%flag = SLBLT_ERROR_ORDER RETURN END IF @@ -2272,14 +2153,14 @@ SUBROUTINE check_order( n, order, invp, control, inform ) invp( j ) = i END DO IF ( i - 1 /= n ) THEN - inform%flag = SSIDS_ERROR_ORDER + inform%flag = SLBLT_ERROR_ORDER RETURN END IF RETURN END SUBROUTINE check_order -! G A L A H A D - S S I D S _ e x p a n d _ p a t t e r n S U B R O U T I N E +! G A L A H A D - S L B L T _ e x p a n d _ p a t t e r n S U B R O U T I N E SUBROUTINE expand_pattern( n, nz, ptr, row, aptr, arow ) @@ -2341,7 +2222,7 @@ SUBROUTINE expand_pattern( n, nz, ptr, row, aptr, arow ) END SUBROUTINE expand_pattern -!- G A L A H A D - S S I D S _ e x p a n d _ m a t r i x S U B R O U T I N E +!- G A L A H A D - S L B L T _ e x p a n d _ m a t r i x S U B R O U T I N E SUBROUTINE expand_matrix( n, nz, ptr, row, val, aptr, arow, aval ) @@ -2407,12 +2288,12 @@ SUBROUTINE expand_matrix( n, nz, ptr, row, val, aptr, arow, aval ) END SUBROUTINE expand_matrix -!-*- G A L A H A D - S S I D S _ c o m p u t e _ f l o p s F U N C T I O N -* +!-*- G A L A H A D - S L B L T _ c o m p u t e _ f l o p s F U N C T I O N -* FUNCTION compute_flops( nnodes, sptr, rptr, node ) ! compute flops for processing a node -! akeep Information generated in analysis phase by SSIDS +! akeep Information generated in analysis phase by SLBLT ! node Node IMPLICIT none @@ -2436,38 +2317,26 @@ FUNCTION compute_flops( nnodes, sptr, rptr, node ) END FUNCTION compute_flops -!- G A L A H A D - S S I D S _ find_subtree_partition F U N C T I O N - +!- G A L A H A D - S L B L T _ find_subtree_partition F U N C T I O N - SUBROUTINE find_subtree_partition( nnodes, sptr, sparent, rptr, control, & topology, nparts, part, exec_loc, & contrib_ptr, contrib_idx, & contrib_dest, inform, st ) -! partition an elimination tree for execution on different NUMA regions -! and GPUs. +! partition an elimination tree for execution on different NUMA regions. ! ! Start with a single tree, and proceed top DOwn splitting the largest subtree ! (in terms of total flops) until we have a sufficient number of independent ! subtrees. A sufficient number is such that subtrees can be assigned to NUMA -! regions and GPUs with a load balance no worse than max_load_inbalance. -! Load balance is calculated as the maximum value over all regions/GPUs of: -! \f[ \frac{ n x_i / \alpha_i } { \sum_j ( x_j/\alpha_j ) } \f] -! Where \f$ \alpha_i \f$ is the performance coefficient of region/GPU i, -! \f$ x_i \f$ is the number of flops assigned to region/GPU i and \f$ n \f$ is -! the total number of regions. \f$ \alpha_i \f$ should be proportional to the -! speed of the region/GPU ( i.e. if GPU is twice as fast as CPU, set alpha for -! CPU to 1.0 and alpha for GPU to 2.0 ). -! -! If the original number of flops is greater than min_gpu_work and the -! performance coefficient of a GPU is greater than the combined coefficients -! of the CPU, then subtrees will not be split to become smaller than -! min_gpu_work until all GPUs are filled. +! regions with a load balance no worse than max_load_inbalance. +! Load balance is calculated as the maximum value over all regions of: +! \f[ \frac{ n x_i } { \sum_j x_j } \f] +! Where \f$ x_i \f$ is the number of flops assigned to region i and \f$ n \f$ +! is the total number of regions. ! ! If the balance criterion cannot be satisfied after we have split into -! 2 * ( total regions/GPUs ), we just use the best obtained value. -! -! GPUs may only handle leaf subtrees, so the top nodes are assigned to the -! full set of CPUs. +! 2 * ( total regions ), we just use the best obtained value. ! ! Parts are returned as contigous ranges of nodes. Part i consists of nodes ! part( i ):part( i + 1 )-1 @@ -2478,20 +2347,14 @@ SUBROUTINE find_subtree_partition( nnodes, sptr, sparent, rptr, control, & ! sparent Supernode parent array. Supernode i has parent sparent( i ). ! rptr Row pointers. Supernode i has rows rlist( rptr( i ):rptr( i + 1 )-1 ). ! topology Machine topology to partition for. -! min_gpu_work Minimum flops for a GPU execution to be worthwhile. ! max_load_inbalance Number greater than 1.0 representing maximum ! permissible load inbalance. -! gpu_perf_coeff The value of \f$ \alpha_i \f$ used for all GPUs, -! assuming that used for all NUMA region CPUs is 1.0. ! nparts Number of parts found. ! parts List of part ranges. Part i consists of supernodes ! part( i ):part( i + 1 )-1. -! exec_loc Execution location. Part i should be run on partition -! mod( ( exec_loc( i ) - 1 ), size( topology ) ) + 1. -! It should be run on the CPUs if -! exec_loc( i ) <= size( topology ), -! otherwise it should be run on GPU number -! ( exec_loc( i ) - 1 )/size( topology ). +! exec_loc Execution location. Part i should be run on NUMA region +! exec_loc( i ) ( in 1:size( topology ) ), or on all regions if +! exec_loc( i ) is -1. ! contrib_ptr Contribution pointer. Part i has contribution from ! subtrees contrib_idx( contrib_ptr( i ):contrib_ptr( i + 1 )-1 ). ! contrib_idx List of contributing subtrees, see contrib_ptr. @@ -2505,15 +2368,15 @@ SUBROUTINE find_subtree_partition( nnodes, sptr, sparent, rptr, control, & INTEGER( ip_ ), DIMENSION( nnodes + 1 ), INTENT( IN ) :: sptr INTEGER( ip_ ), DIMENSION( nnodes ), INTENT( IN ) :: sparent INTEGER( long_ ), DIMENSION( nnodes + 1 ), INTENT( IN ) :: rptr - TYPE( ssids_control_type ), INTENT( IN ) :: control - TYPE( HW_numa_region ), DIMENSION( : ), INTENT( IN ) :: topology + TYPE( slblt_control_type ), INTENT( IN ) :: control + TYPE( TOPOLOGY_numa_region ), DIMENSION( : ), INTENT( IN ) :: topology INTEGER( ip_ ), INTENT( OUT ) :: nparts INTEGER( ip_ ), DIMENSION( : ), ALLOCATABLE, INTENT( INOUT ) :: part INTEGER( ip_ ), DIMENSION( : ), ALLOCATABLE, INTENT( OUT ) :: exec_loc INTEGER( ip_ ), DIMENSION( : ), ALLOCATABLE, INTENT( INOUT ) :: contrib_ptr INTEGER( ip_ ), DIMENSION( : ), ALLOCATABLE, INTENT( INOUT ) :: contrib_idx INTEGER( ip_ ), DIMENSION( : ), ALLOCATABLE, INTENT( OUT ) :: contrib_dest - TYPE( ssids_inform_type ), INTENT( INOUT ) :: inform + TYPE( slblt_inform_type ), INTENT( INOUT ) :: inform INTEGER( ip_ ), INTENT( OUT ) :: st INTEGER( ip_ ) :: i, j, k @@ -2522,7 +2385,7 @@ SUBROUTINE find_subtree_partition( nnodes, sptr, sparent, rptr, control, & INTEGER( ip_ ), DIMENSION( : ), ALLOCATABLE :: size_order LOGICAL, DIMENSION( : ), ALLOCATABLE :: is_child REAL :: load_balance, best_load_balance - INTEGER( ip_ ) :: nregion, ngpu + INTEGER( ip_ ) :: nregion LOGICAL :: has_parent ! count flops below each node @@ -2552,13 +2415,9 @@ SUBROUTINE find_subtree_partition( nnodes, sptr, sparent, rptr, control, & END DO CALL create_size_order( nparts, part, flops, size_order ) -! calculate number of regions/gpus +! calculate number of regions nregion = SIZE( topology ) - ngpu = 0 - DO i = 1, SIZE( topology ) - ngpu = ngpu + SIZE( topology( i )%gpus ) - END DO ! keep splitting until we meet balance criterion @@ -2566,18 +2425,16 @@ SUBROUTINE find_subtree_partition( nnodes, sptr, sparent, rptr, control, & ! check load balance criterion - DO i = 1, 2 * ( nregion + ngpu ) + DO i = 1, 2 * nregion load_balance = calc_exec_alloc( nparts, part, size_order, is_child, & - flops, topology, control%min_gpu_work, & - control%gpu_perf_coeff, exec_loc, st ) + flops, topology, exec_loc, st ) IF ( st /= 0 ) RETURN best_load_balance = min( load_balance, best_load_balance ) IF ( load_balance < control%max_load_inbalance ) EXIT ! allocation is ok ! split tree further - CALL split_tree( nparts, part, size_order, is_child, sparent, flops, & - ngpu, control%min_gpu_work, st ) + CALL split_tree( nparts, part, size_order, is_child, sparent, flops, st ) IF ( st /= 0 ) RETURN END DO @@ -2608,8 +2465,7 @@ SUBROUTINE find_subtree_partition( nnodes, sptr, sparent, rptr, control, & CALL create_size_order( nparts, part, flops, size_order ) load_balance = calc_exec_alloc( nparts, part, size_order, is_child, & - flops, topology, control%min_gpu_work, & - control%gpu_perf_coeff, exec_loc, st ) + flops, topology, exec_loc, st ) IF ( st /= 0 ) RETURN !print * , "exec_loc ", exec_loc( 1 : nparts ) @@ -2686,35 +2542,24 @@ SUBROUTINE find_subtree_partition( nnodes, sptr, sparent, rptr, control, & ! fill out inform inform%nparts = nparts - inform%gpu_flops = 0 - DO i = 1, nparts - IF ( exec_loc( i ) > SIZE( topology ) ) & - inform%gpu_flops = inform%gpu_flops + flops( part( i + 1 ) - 1 ) - END DO - inform%cpu_flops = flops( nnodes + 1 ) - inform%gpu_flops + inform%flops = flops( nnodes + 1 ) RETURN END SUBROUTINE find_subtree_partition -!- G A L A H A D - S S I D S _ calc_exec_alloc F U N C T I O N - +!- G A L A H A D - S L B L T _ calc_exec_alloc F U N C T I O N - REAL FUNCTION calc_exec_alloc( nparts, part, size_order, is_child, flops, & - topology, min_gpu_work, gpu_perf_coeff, & - exec_loc, st ) + topology, exec_loc, st ) ! allocate execution of subtrees to resources and calculate load balance ! ! Given the partition supplied, uses a greedy algorithm to assign subtrees to -! resources specified by topology and then returns the resulting load balance -! as -! \f[ \frac{\max_i( n x_i / \alpha_i )} { \sum_j ( x_j/\alpha_j ) } \f] -! Where \f$ \alpha_i \f$ is the performance coefficient of region/GPU i, -! \f$ x_i \f$ is the number of flops assigned to region/GPU i and \f$ n \f$ is -! the total number of regions. \f$ \alpha_i \f$ should be proportional to the -! speed of the region/GPU ( i.e. if GPU is twice as fast as CPU, set alpha for -! CPU to 1.0 and alpha for GPU to 2.0 ). -! -! Work is only assigned to GPUs if the subtree has at least min_gpu_work flops +! the NUMA regions specified by topology and then returns the resulting load +! balance as +! \f[ \frac{\max_i( n x_i )} { \sum_j x_j } \f] +! Where \f$ x_i \f$ is the number of flops assigned to region i and \f$ n \f$ +! is the total number of regions. ! ! None-child subtrees are ignored ( they will be executed using all available ! resources ). They are recorded with exec_loc -1. @@ -2728,21 +2573,12 @@ REAL FUNCTION calc_exec_alloc( nparts, part, size_order, is_child, flops, & ! from other subtrees ). ! flops Number of floating points in subtree rooted at each node. ! topology Machine topology to allocate execution for. -! min_gpu_work Minimum work before allocation to GPU is useful. -! gpu_perf_coeff The value of \f$ \alpha_i \f$ used for all GPUs, -! assuming that used for all NUMA region CPUs is 1.0. -! exec_loc Execution location. Part i should be run on partition -! mod( ( exec_loc( i ) - 1 ), size( topology ) ) + 1. -! It should be run on the CPUs if -! exec_loc( i ) <= size( topology ), -! otherwise it should be run on GPU number -! ( exec_loc( i ) - 1 )/size( topology ). +! exec_loc Execution location. Part i should be run on NUMA region +! exec_loc( i ) ( in 1:size( topology ) ). ! st Allocation status parameter. If non-zero an allocation error ! occurred. ! Load balance value as detailed in subroutine description. ! see also find_subtree_partition( ) -! FIXME: Consider case when gpu_perf_coeff > 2.0 ??? -! ( Round robin may not be correct thing ) IMPLICIT none INTEGER( ip_ ), INTENT( IN ) :: nparts @@ -2750,69 +2586,23 @@ REAL FUNCTION calc_exec_alloc( nparts, part, size_order, is_child, flops, & INTEGER( ip_ ), DIMENSION( nparts ), INTENT( IN ) :: size_order LOGICAL, DIMENSION( nparts ), INTENT( IN ) :: is_child INTEGER( long_ ), DIMENSION( * ), INTENT( IN ) :: flops - TYPE( HW_numa_region ), DIMENSION( : ), INTENT( IN ) :: topology - INTEGER( long_ ), INTENT( IN ) :: min_gpu_work - REAL, INTENT( IN ) :: gpu_perf_coeff + TYPE( TOPOLOGY_numa_region ), DIMENSION( : ), INTENT( IN ) :: topology INTEGER( ip_ ), DIMENSION( nparts ), INTENT( OUT ) :: exec_loc INTEGER( ip_ ), INTENT( OUT ) :: st - INTEGER( ip_ ) :: i, p, nregion, ngpu, max_gpu, next + INTEGER( ip_ ) :: i, p, nregion, next INTEGER( long_ ) :: pflops - -! list resources in order of decreasing power - - INTEGER( ip_ ), DIMENSION( : ), ALLOCATABLE :: map REAL, DIMENSION( : ), ALLOCATABLE :: load_balance REAL :: total_balance ! initialise in case of an error return calc_exec_alloc = huge( calc_exec_alloc ) - -! create resource map + st = 0 nregion = SIZE( topology ) - ngpu = 0 - max_gpu = 0 - DO i = 1, SIZE( topology ) - ngpu = ngpu + SIZE( topology( i )%gpus ) - max_gpu = max( max_gpu, size( topology( i )%gpus ) ) - END DO - ALLOCATE( map( nregion + ngpu ), STAT = st ) - IF ( st /= 0 ) RETURN - -! GPUs are more powerful than CPUs - - IF ( gpu_perf_coeff > 1.0 ) THEN - next = 1 - DO i = 1, SIZE( topology ) - DO p = 1, SIZE( topology( i )%gpus ) - map( next ) = p * nregion + i - next = next + 1 - END DO - END DO - DO i = 1, SIZE( topology ) - map( next ) = i - next = next + 1 - END DO - -! CPUs are more powerful than GPUs - - ELSE - next = 1 - DO i = 1, SIZE( topology ) - map( next ) = i - next = next + 1 - END DO - DO i = 1, SIZE( topology ) - DO p = 1, SIZE( topology( i )%gpus ) - map( next ) = p * nregion + i - next = next + 1 - END DO - END DO - END IF -! simple round robin allocation in decreasing size order. +! simple round robin allocation over NUMA regions in decreasing size order. next = 1 DO i = 1, nparts @@ -2825,23 +2615,14 @@ REAL FUNCTION calc_exec_alloc( nparts, part, size_order, is_child, flops, & CYCLE END IF -! avoid GPUs - - pflops = flops( part( p + 1 ) - 1 ) - IF ( pflops < min_gpu_work ) THEN - DO while ( map( next ) > nregion ) - next = next + 1 - IF ( next > SIZE( map ) ) next = 1 - END DO - END IF - exec_loc( p ) = map( next ) + exec_loc( p ) = next next = next + 1 - IF ( next > SIZE( map ) ) next = 1 + IF ( next > nregion ) next = 1 END DO ! calculate load inbalance - ALLOCATE( load_balance( nregion * ( 1 + max_gpu ) ), STAT = st ) + ALLOCATE( load_balance( nregion ), STAT = st ) IF ( st /= 0 ) RETURN load_balance( : ) = 0.0 total_balance = 0.0 @@ -2851,40 +2632,27 @@ REAL FUNCTION calc_exec_alloc( nparts, part, size_order, is_child, flops, & DO p = 1, nparts IF ( exec_loc( p ) == - 1 ) CYCLE ! not a child subtree pflops = flops( part( p + 1 ) - 1 ) - -! GPU - - IF ( exec_loc( p ) > nregion ) THEN - load_balance( exec_loc( p ) ) & - = load_balance( exec_loc( p ) ) + REAL( pflops ) / gpu_perf_coeff - total_balance = total_balance + REAL( pflops ) / gpu_perf_coeff - - ! CPU - - ELSE - load_balance( exec_loc( p ) ) & - = load_balance( exec_loc( p ) ) + REAL( pflops ) - total_balance = total_balance + REAL( pflops ) - END IF + load_balance( exec_loc( p ) ) & + = load_balance( exec_loc( p ) ) + REAL( pflops ) + total_balance = total_balance + REAL( pflops ) END DO -! calculate n * max( x_i / a_i ) / sum( x_j / a_j ) +! calculate n * max( x_i ) / sum( x_j ) calc_exec_alloc & - = REAL( nregion + ngpu ) * maxval( load_balance( : ) ) / total_balance + = REAL( nregion ) * maxval( load_balance( : ) ) / total_balance RETURN END FUNCTION calc_exec_alloc -!-*- G A L A H A D - S S I D S _ s p l i t _ t r e e S U B R O U T I N E -*- +!-*- G A L A H A D - S L B L T _ s p l i t _ t r e e S U B R O U T I N E -*- SUBROUTINE split_tree( nparts, part, size_order, is_child, sparent, flops, & - ngpu, min_gpu_work, st ) + st ) ! split tree into an additional part as required by find_subtree_partition( ). ! -! split largest partition into two parts, unless DOing so would reduce the -! number of subtrees with at least min_gpu_work below ngpu. +! split largest partition into two parts. ! ! Note: We require all input parts to have a single root. ! @@ -2896,8 +2664,6 @@ SUBROUTINE split_tree( nparts, part, size_order, is_child, sparent, flops, & ! from other subtrees ). ! sparent Supernode parent array. Supernode i has parent sparent( i ). ! flops Number of floating points in subtree rooted at each node. -! ngpu Number of gpus. -! min_gpu_work Minimum worthwhile work to give to GPU. ! st Allocation status parameter. If non-zero an allocation error ! occurred. ! see also find_subtree_partition( ) @@ -2909,11 +2675,9 @@ SUBROUTINE split_tree( nparts, part, size_order, is_child, sparent, flops, & LOGICAL, DIMENSION( * ), INTENT( INOUT ) :: is_child INTEGER( ip_ ), DIMENSION( * ), INTENT( IN ) :: sparent INTEGER( long_ ), DIMENSION( * ), INTENT( IN ) :: flops - INTEGER( ip_ ), INTENT( IN ) :: ngpu - INTEGER( long_ ), INTENT( IN ) :: min_gpu_work INTEGER( ip_ ), INTENT( OUT ) :: st - INTEGER( ip_ ) :: i, p, nchild, nbig, root, to_split, old_nparts + INTEGER( ip_ ) :: i, nchild, root, to_split, old_nparts INTEGER( ip_ ), DIMENSION( : ), ALLOCATABLE :: children, temp ! look for all children of root in biggest child part @@ -2953,23 +2717,6 @@ SUBROUTINE split_tree( nparts, part, size_order, is_child, sparent, flops, & ! check we can split safely IF ( nchild == 0 ) RETURN ! singleton node, can't split - nbig = 0 ! number of new parts > min_gpu_work - DO i = to_split + 1, nparts - p = size_order( i ) - IF ( .NOT. is_child( p ) ) CYCLE ! non-children can't go on GPUs - root = part( p + 1 ) - 1 - IF ( flops( root ) < min_gpu_work ) EXIT - nbig = nbig + 1 - END DO - -! original partition met min_gpu_work criterion - - IF ( ( nbig + 1 ) >= ngpu ) THEN - DO i = 1, nchild - IF ( flops( children( i ) ) >= min_gpu_work ) nbig = nbig + 1 - END DO - IF ( nbig < ngpu ) RETURN ! new partition fails min_gpu_work criterion - END IF ! Can safely split, so DO so. As part to_split was contigous, when ! split the new parts fall into the same region. Thus, we first push any @@ -2997,7 +2744,7 @@ SUBROUTINE split_tree( nparts, part, size_order, is_child, sparent, flops, & END SUBROUTINE split_tree -!- G A L A H A D - S S I D S _ create_size_order S U B R O U T I N E - +!- G A L A H A D - S L B L T _ create_size_order S U B R O U T I N E - SUBROUTINE create_size_order( nparts, part, flops, size_order ) @@ -3038,7 +2785,7 @@ SUBROUTINE create_size_order( nparts, part, flops, size_order ) END SUBROUTINE create_size_order -!- G A L A H A D - S S I D S _ p r i n t _ a t r e e S U B R O U T I N E - +!- G A L A H A D - S L B L T _ p r i n t _ a t r e e S U B R O U T I N E - SUBROUTINE print_atree( nnodes, sptr, sparent, rptr ) @@ -3117,7 +2864,7 @@ SUBROUTINE print_atree( nnodes, sptr, sparent, rptr ) END SUBROUTINE print_atree -!- G A L A H A D - S S I D S _ print_atree_part S U B R O U T I N E - +!- G A L A H A D - S L B L T _ print_atree_part S U B R O U T I N E - SUBROUTINE print_atree_part( nnodes, sptr, sparent, rptr, topology, & nparts, part, exec_loc ) @@ -3129,7 +2876,7 @@ SUBROUTINE print_atree_part( nnodes, sptr, sparent, rptr, topology, & INTEGER( ip_ ), DIMENSION( nnodes + 1 ), INTENT( IN ) :: sptr INTEGER( ip_ ), DIMENSION( nnodes ), INTENT( IN ) :: sparent INTEGER( long_ ), DIMENSION( nnodes + 1 ), INTENT( IN ) :: rptr - TYPE( HW_numa_region ), DIMENSION( : ), INTENT( IN ) :: topology + TYPE( TOPOLOGY_numa_region ), DIMENSION( : ), INTENT( IN ) :: topology INTEGER( ip_ ), INTENT( IN ) :: nparts INTEGER( ip_ ), DIMENSION( : ), ALLOCATABLE, INTENT( IN ) :: part INTEGER( ip_ ), DIMENSION( : ), ALLOCATABLE, INTENT( IN ) :: exec_loc @@ -3164,17 +2911,13 @@ SUBROUTINE print_atree_part( nnodes, sptr, sparent, rptr, topology, & WRITE( 2, '( "]" )' ) DO i = 1, nparts - region = mod( ( exec_loc( i ) - 1 ), size( topology ) ) + 1 + region = exec_loc( i ) ! print * , "part = ", i, ", exec_loc = ", exec_loc( i ), & ! ", region = ", region WRITE( part_str, '( i5 )' )part( i ) WRITE( 2, * )"subgraph cluster"// adjustl( trim( part_str ) ) // " {" - IF ( exec_loc( i ) > size( topology ) ) THEN ! GPU subtree - WRITE( 2, * )"color=red" - ELSE - WRITE( 2, * )"color=black" - END IF + WRITE( 2, * )"color=black" WRITE( 2, '( "label=""" )', ADVANCE = 'no' ) WRITE( 2, '( "part:", i5,"\n" )', ADVANCE = 'no' ) i WRITE( 2, '( "region:", i5,"\n" )', ADVANCE = 'no' ) region @@ -3228,7 +2971,7 @@ SUBROUTINE print_atree_part( nnodes, sptr, sparent, rptr, topology, & END SUBROUTINE print_atree_part -!- G A L A H A D - S S I D S _ b u i l d _ m a p S U B R O U T I N E - +!- G A L A H A D - S L B L T _ b u i l d _ m a p S U B R O U T I N E - SUBROUTINE build_map( n, ptr, row, perm, invp, nnodes, sptr, rptr, rlist, & nptr, nlist, st ) @@ -3360,7 +3103,7 @@ END SUBROUTINE build_map ! ================ extracted from SPRAL_CORE_ANALYSE module ================== ! ============================================================================ -!- G A L A H A D - S S I D S _ b a s i c _ a n a l y s e S U B R O U T I N E +!- G A L A H A D - S L B L T _ b a s i c _ a n a l y s e S U B R O U T I N E SUBROUTINE basic_analyse( n, ptr, row, perm, nnodes, sptr, sparent, rptr, & rlist, nemin, info, stat, nfact, nflops ) @@ -3488,7 +3231,7 @@ SUBROUTINE basic_analyse( n, ptr, row, perm, nnodes, sptr, sparent, rptr, & CALL find_postorder( n, realn, ptr, perm, invp, parent, st ) IF ( st /= 0 ) GO TO 490 - IF ( n /= realn ) info = SSIDS_WARNING_ANALYSIS_SINGULAR + IF ( n /= realn ) info = SLBLT_WARNING_ANALYSIS_SINGULAR ! determine column counts @@ -3530,7 +3273,7 @@ SUBROUTINE basic_analyse( n, ptr, row, perm, nnodes, sptr, sparent, rptr, & ! error handlers 490 CONTINUE - info = SSIDS_ERROR_ALLOCATION + info = SLBLT_ERROR_ALLOCATION stat = st RETURN @@ -3540,7 +3283,7 @@ END SUBROUTINE basic_analyse ! Elimination tree routines !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!-*- G A L A H A D - S S I D S _ f i n d _ e t r e e S U B R O U T I N E -*- +!-*- G A L A H A D - S L B L T _ f i n d _ e t r e e S U B R O U T I N E -*- SUBROUTINE find_etree( n, ptr, row, perm, invp, parent, st ) @@ -3629,7 +3372,7 @@ SUBROUTINE find_etree( n, ptr, row, perm, invp, parent, st ) END SUBROUTINE find_etree -!- G A L A H A D - S S I D S _ find_postorder S U B R O U T I N E - +!- G A L A H A D - S L B L T _ find_postorder S U B R O U T I N E - SUBROUTINE find_postorder( n, realn, ptr, perm, invp, parent, st ) @@ -3790,7 +3533,7 @@ END SUBROUTINE find_postorder ! Column count routines !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!- G A L A H A D - S S I D S _ find_col_counts S U B R O U T I N E - +!- G A L A H A D - S L B L T _ find_col_counts S U B R O U T I N E - SUBROUTINE find_col_counts( n, ptr, row, perm, invp, parent, cc, st ) @@ -3989,7 +3732,7 @@ END FUNCTION FIND ! Supernode amalgamation routines !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!- G A L A H A D - S S I D S _ find_supernodes S U B R O U T I N E - +!- G A L A H A D - S L B L T _ find_supernodes S U B R O U T I N E - SUBROUTINE find_supernodes( n, realn, parent, cc, sperm, nnodes, sptr, & sparent, scc, nemin, info, st ) @@ -4230,12 +3973,12 @@ SUBROUTINE find_supernodes( n, realn, parent, cc, sperm, nnodes, sptr, & RETURN 490 CONTINUE - info = SSIDS_ERROR_ALLOCATION + info = SLBLT_ERROR_ALLOCATION RETURN END SUBROUTINE find_supernodes -!- G A L A H A D - S S I D S _ sort_by_val S U B R O U T I N E - +!- G A L A H A D - S L B L T _ sort_by_val S U B R O U T I N E - RECURSIVE SUBROUTINE sort_by_val( n, idx, val, st ) @@ -4277,7 +4020,7 @@ RECURSIVE SUBROUTINE sort_by_val( n, idx, val, st ) END SUBROUTINE sort_by_val -!- G A L A H A D - S S I D S _ sort_by_val_ms S U B R O U T I N E - +!- G A L A H A D - S L B L T _ sort_by_val_ms S U B R O U T I N E - RECURSIVE SUBROUTINE sort_by_val_ms( n, idx, val, st ) @@ -4342,7 +4085,7 @@ RECURSIVE SUBROUTINE sort_by_val_ms( n, idx, val, st ) END SUBROUTINE sort_by_val_ms -!-*- G A L A H A D - S S I D S _ d o _ m e r g e F U C T T I O N -*- +!-*- G A L A H A D - S L B L T _ d o _ m e r g e F U C T T I O N -*- LOGICAL FUNCTION do_merge( node, par, nelim, cc, ezero, nemin ) @@ -4367,7 +4110,7 @@ LOGICAL FUNCTION do_merge( node, par, nelim, cc, ezero, nemin ) END FUNCTION do_merge -!- G A L A H A D - S S I D S _ merge_nodes S U B R O U T I N E - +!- G A L A H A D - S L B L T _ merge_nodes S U B R O U T I N E - SUBROUTINE merge_nodes( node, par, nelim, nvert, vhead, vnext, height, & ezero, cc ) @@ -4411,7 +4154,7 @@ END SUBROUTINE merge_nodes ! Statistics routines !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!- G A L A H A D - S S I D S _ S U B R O U T I N E - +!- G A L A H A D - S L B L T _ S U B R O U T I N E - SUBROUTINE calc_stats( nnodes, sptr, scc, nfact, nflops ) @@ -4467,7 +4210,7 @@ END SUBROUTINE calc_stats ! Row list routines !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!- G A L A H A D - S S I D S _ find_row_lists S U B R O U T I N E - +!- G A L A H A D - S L B L T _ find_row_lists S U B R O U T I N E - SUBROUTINE find_row_lists( n, ptr, row, perm, invp, nnodes, & sptr, sparent, scc, rptr, rlist, info, st ) @@ -4507,7 +4250,7 @@ SUBROUTINE find_row_lists( n, ptr, row, perm, invp, nnodes, & ALLOCATE( seen( n ), chead( nnodes + 1 ), cnext( nnodes + 1 ), STAT = st ) IF ( st /= 0 ) THEN - info = SSIDS_ERROR_ALLOCATION + info = SLBLT_ERROR_ALLOCATION RETURN END IF seen( : ) = 0 @@ -4579,7 +4322,7 @@ END SUBROUTINE find_row_lists ! Assorted auxilary routines !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!- G A L A H A D - S S I D S _ dbl_tr_sort S U B R O U T I N E - +!- G A L A H A D - S L B L T _ dbl_tr_sort S U B R O U T I N E - SUBROUTINE dbl_tr_sort( n, nnodes, rptr, rlist, st ) @@ -4650,7 +4393,7 @@ SUBROUTINE dbl_tr_sort( n, nnodes, rptr, rlist, st ) END SUBROUTINE dbl_tr_sort -!- G A L A H A D - S S I D S _ apply_perm S U B R O U T I N E - +!- G A L A H A D - S L B L T _ apply_perm S U B R O U T I N E - SUBROUTINE apply_perm( n, perm, order, invp, cc ) @@ -4691,18 +4434,18 @@ SUBROUTINE apply_perm( n, perm, order, invp, cc ) END SUBROUTINE apply_perm ! ============================================================================ -! =================== extracted from SSIDS_AKEEP module ====================== +! =================== extracted from SLBLT_AKEEP module ====================== ! ============================================================================ -! ============= define ssids_akeep type and associated procedures ============ +! ============= define slblt_akeep type and associated procedures ============ ! ============================================================================ -!-*- G A L A H A D - S S I D S _ F R E E _ A K E E P S U B R O U T I N E -*- +!-*- G A L A H A D - S L B L T _ F R E E _ A K E E P S U B R O U T I N E -*- SUBROUTINE free_akeep( akeep, flag ) ! free all allocated components of the type akeep - CLASS( ssids_akeep_type ), INTENT( INOUT ) :: akeep + CLASS( slblt_akeep_type ), INTENT( INOUT ) :: akeep INTEGER( ip_ ), INTENT( OUT ) :: flag ! local variables @@ -4730,18 +4473,18 @@ SUBROUTINE free_akeep( akeep, flag ) END SUBROUTINE free_akeep -!-*-*- G A L A H A D - S S I D S _ final _ akeep S U B R O U T I N E -*-*- +!-*-*- G A L A H A D - S L B L T _ final _ akeep S U B R O U T I N E -*-*- SUBROUTINE final_akeep( akeep ) -! finalizer for SSIDS_akeep_type. Ensures the C++ symbolic subtrees (reached +! finalizer for SLBLT_akeep_type. Ensures the symbolic subtrees (reached ! only through the akeep%subtree pointer array) are destroyed whenever an akeep ! is deallocated, reset by an INTENT( OUT ) argument, or goes out of scope. ! Without this, Fortran deallocates the pointer array but not its targets, -! leaking the C++ objects. free_akeep is guarded by ASSOCIATED/ALLOCATED, so -! running it again after an explicit SSIDS_free is a safe no-op. +! leaking the objects. free_akeep is guarded by ASSOCIATED/ALLOCATED, so +! running it again after an explicit SLBLT_free is a safe no-op. - TYPE( ssids_akeep_type ), INTENT( INOUT ) :: akeep + TYPE( slblt_akeep_type ), INTENT( INOUT ) :: akeep ! local variables @@ -4753,37 +4496,32 @@ SUBROUTINE final_akeep( akeep ) END SUBROUTINE final_akeep ! ============================================================================ -! =================== extracted from SSIDS_FKEEP module ====================== +! =================== extracted from SLBLT_FKEEP module ====================== ! ============================================================================ -! ====== define ssids_fkeep type and associated procedures (CPU version) ===== +! ====== define slblt_fkeep type and associated procedures (CPU version) ===== ! ============================================================================ -!-*- G A L A H A D - S S I D S _inner _ factor _ cpu S U B R O U T I N E -*- +!-*-*- G A L A H A D - S L B L T _ inner _ factor S U B R O U T I N E -*-*- - SUBROUTINE inner_factor_cpu( fkeep, akeep, val, control, inform ) + SUBROUTINE inner_factor( fkeep, akeep, val, control, inform ) IMPLICIT none - TYPE( SSIDS_akeep_type ), INTENT( IN ) :: akeep - CLASS( SSIDS_fkeep_type ), TARGET, INTENT( INOUT ) :: fkeep + TYPE( SLBLT_akeep_type ), INTENT( IN ) :: akeep + CLASS( SLBLT_fkeep_type ), TARGET, INTENT( INOUT ) :: fkeep REAL( KIND = rp_ ), DIMENSION( * ), TARGET, INTENT( IN ) :: val - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type ), INTENT( INOUT ) :: inform + TYPE( SLBLT_control_type ), INTENT( IN ) :: control + TYPE( SLBLT_inform_type ), INTENT( INOUT ) :: inform ! local variables INTEGER( KIND = ip_ ) :: i, numa_region, exec_loc, my_loc - INTEGER( KIND = ip_ ) :: total_threads, max_gpus, to_launch, thread_num + INTEGER( KIND = ip_ ) :: total_threads, to_launch, thread_num INTEGER( KIND = ip_ ) :: nth ! Number of threads within a region - INTEGER( KIND = ip_ ) :: ngpus ! Number of GPUs in a given NUMA region LOGICAL :: abort, all_region TYPE( contrib_type ), DIMENSION( : ), ALLOCATABLE :: child_contrib - TYPE( ssids_inform_type ), DIMENSION( : ), ALLOCATABLE :: thread_inform + TYPE( slblt_inform_type ), DIMENSION( : ), ALLOCATABLE :: thread_inform ! begin profile trace (noop if not enabled) -#ifdef PROFILE - CALL profile_begin( akeep%topology ) -#endif - ! allocate space for subtrees ALLOCATE( fkeep%subtree( akeep%nparts ), STAT = inform%stat ) @@ -4792,10 +4530,8 @@ SUBROUTINE inner_factor_cpu( fkeep, akeep, val, control, inform ) ! determine resources total_threads = 0 - max_gpus = 0 DO i = 1, SIZE( akeep%topology ) total_threads = total_threads + akeep%topology( i )%nproc - max_gpus = MAX( max_gpus, SIZE( akeep%topology( i )%gpus ) ) END DO ! CALL subtree factor routines @@ -4805,7 +4541,7 @@ SUBROUTINE inner_factor_cpu( fkeep, akeep, val, control, inform ) ! split into numa regions; parallelism within a region is responsibility ! of subtrees - to_launch = SIZE( akeep%topology ) * ( 1 + max_gpus ) + to_launch = SIZE( akeep%topology ) ALLOCATE( thread_inform( to_launch ), STAT = inform%stat ) IF ( inform%stat /= 0 ) GO TO 200 all_region = .FALSE. @@ -4813,7 +4549,7 @@ SUBROUTINE inner_factor_cpu( fkeep, akeep, val, control, inform ) !$omp parallel proc_bind( spread ) num_threads( to_launch ) & !$omp default( none ) & !$omp private( abort, i, exec_loc, numa_region, my_loc, thread_num ) & -!$omp private( nth, ngpus ) & +!$omp private( nth ) & !$omp shared( akeep, fkeep, val, control, thread_inform, child_contrib, & !$omp all_region ) & !$omp if ( to_launch.gt.1 ) @@ -4822,20 +4558,14 @@ SUBROUTINE inner_factor_cpu( fkeep, akeep, val, control, inform ) !$ thread_num = omp_get_thread_num( ) numa_region = MOD( thread_num, SIZE( akeep%topology ) ) + 1 my_loc = thread_num + 1 - IF ( thread_num < SIZE( akeep%topology ) ) THEN - ngpus = SIZE( akeep%topology( numa_region )%gpus, 1 ) -! CPU, control number of inner threads (not needed for gpu) +! control number of inner threads for this NUMA region - nth = akeep%topology( numa_region )%nproc -! nth = nth - ngpus - ELSE - nth = 1 - END IF + nth = akeep%topology( numa_region )%nproc !$ CALL omp_set_num_threads( int( nth ) ) -! split into threads for this NUMA region (unless we're running a GPU) +! split into threads for this NUMA region exec_loc = - 1 ! avoid compiler warning re uninitialized abort = .FALSE. @@ -4899,10 +4629,6 @@ SUBROUTINE inner_factor_cpu( fkeep, akeep, val, control, inform ) ! at least some all region subtrees exist IF ( all_region ) THEN -#ifdef PROFILE - CALL profile_add_event( "EV_ALL_REGIONS", & - "Starting processing root subtree", 0 ) -#endif !$omp parallel num_threads( total_threads ) default( shared ) !$omp single @@ -4936,29 +4662,25 @@ SUBROUTINE inner_factor_cpu( fkeep, akeep, val, control, inform ) 100 CONTINUE -! end profile trace (noop if not enabled) -#ifdef PROFILE - CALL profile_end( ) -#endif RETURN 200 CONTINUE - inform%flag = SSIDS_ERROR_ALLOCATION + inform%flag = SLBLT_ERROR_ALLOCATION GO TO 100 ! cleanup and exit RETURN - END SUBROUTINE inner_factor_cpu + END SUBROUTINE inner_factor -!-*- G A L A H A D - S S I D S _ inner _ solve _ cpu S U B R O U T I N E -*- +!-*-*- G A L A H A D - S L B L T _ inner _ solve S U B R O U T I N E -*-*- - SUBROUTINE inner_solve_cpu( local_job, nrhs, x, ldx, akeep, fkeep, inform ) - TYPE( ssids_akeep_type ), INTENT( IN ) :: akeep - CLASS( ssids_fkeep_type ), INTENT( INOUT ) :: fkeep + SUBROUTINE inner_solve( local_job, nrhs, x, ldx, akeep, fkeep, inform ) + TYPE( slblt_akeep_type ), INTENT( IN ) :: akeep + CLASS( slblt_fkeep_type ), INTENT( INOUT ) :: fkeep INTEGER( KIND = ip_ ), INTENT( INOUT ) :: local_job INTEGER( KIND = ip_ ), INTENT( IN ) :: nrhs INTEGER( KIND = ip_ ), INTENT( IN ) :: ldx REAL( KIND = rp_ ), DIMENSION( ldx, nrhs ), TARGET, INTENT( INOUT ) :: x - TYPE( ssids_inform_type ), INTENT( INOUT ) :: inform + TYPE( slblt_inform_type ), INTENT( INOUT ) :: inform ! local variables @@ -4974,8 +4696,8 @@ SUBROUTINE inner_solve_cpu( local_job, nrhs, x, ldx, akeep, fkeep, inform ) ! permute/scale IF ( ALLOCATED( fkeep%scaling ) .AND. & - ( local_job == SSIDS_SOLVE_JOB_ALL .OR. & - local_job == SSIDS_SOLVE_JOB_FWD ) ) THEN + ( local_job == SLBLT_SOLVE_JOB_ALL .OR. & + local_job == SLBLT_SOLVE_JOB_FWD ) ) THEN ! copy and scale @@ -4995,30 +4717,30 @@ SUBROUTINE inner_solve_cpu( local_job, nrhs, x, ldx, akeep, fkeep, inform ) ! perform relevant solves - IF ( local_job == SSIDS_SOLVE_JOB_FWD .OR. & - local_job == SSIDS_SOLVE_JOB_ALL ) THEN + IF ( local_job == SLBLT_SOLVE_JOB_FWD .OR. & + local_job == SLBLT_SOLVE_JOB_ALL ) THEN DO part = 1, akeep%nparts CALL fkeep%subtree( part )%ptr%solve_fwd( nrhs, x2, n, inform ) IF ( inform%stat /= 0 ) GO TO 100 END DO END IF - IF ( local_job == SSIDS_SOLVE_JOB_DIAG ) THEN + IF ( local_job == SLBLT_SOLVE_JOB_DIAG ) THEN DO part = 1, akeep%nparts CALL fkeep%subtree( part )%ptr%solve_diag( nrhs, x2, n, inform ) IF ( inform%stat /= 0 ) GO TO 100 END DO END IF - IF ( local_job == SSIDS_SOLVE_JOB_BWD ) THEN + IF ( local_job == SLBLT_SOLVE_JOB_BWD ) THEN DO part = akeep%nparts, 1, -1 CALL fkeep%subtree( part )%ptr%solve_bwd( nrhs, x2, n, inform ) IF ( inform%stat /= 0 ) GO TO 100 END DO END IF - IF ( local_job == SSIDS_SOLVE_JOB_DIAG_BWD .OR. & - local_job == SSIDS_SOLVE_JOB_ALL ) THEN + IF ( local_job == SLBLT_SOLVE_JOB_DIAG_BWD .OR. & + local_job == SLBLT_SOLVE_JOB_ALL ) THEN DO part = akeep%nparts, 1, - 1 CALL fkeep%subtree( part )%ptr%solve_diag_bwd( nrhs, x2, n, inform ) IF ( inform%stat /= 0 ) GO TO 100 @@ -5028,9 +4750,9 @@ SUBROUTINE inner_solve_cpu( local_job, nrhs, x, ldx, akeep, fkeep, inform ) ! unscale/unpermute IF ( ALLOCATED( fkeep%scaling ) .AND. & - ( local_job == SSIDS_SOLVE_JOB_ALL .OR. & - local_job == SSIDS_SOLVE_JOB_BWD .OR. & - local_job == SSIDS_SOLVE_JOB_DIAG_BWD ) ) THEN + ( local_job == SLBLT_SOLVE_JOB_ALL .OR. & + local_job == SLBLT_SOLVE_JOB_BWD .OR. & + local_job == SLBLT_SOLVE_JOB_DIAG_BWD ) ) THEN ! copy and scale @@ -5051,16 +4773,16 @@ SUBROUTINE inner_solve_cpu( local_job, nrhs, x, ldx, akeep, fkeep, inform ) RETURN 100 CONTINUE - inform%flag = SSIDS_ERROR_ALLOCATION + inform%flag = SLBLT_ERROR_ALLOCATION RETURN - END SUBROUTINE inner_solve_cpu + END SUBROUTINE inner_solve -!-*- G A L A H A D - S S I D S _ enquire_posdef_cpu S U B R O U T I N E -*- +!-*- G A L A H A D - S L B L T _ enquire_posdef S U B R O U T I N E -*- - SUBROUTINE enquire_posdef_cpu( akeep, fkeep, d ) - TYPE( ssids_akeep_type ), INTENT( IN ) :: akeep - CLASS( ssids_fkeep_type ), TARGET, INTENT( IN ) :: fkeep + SUBROUTINE enquire_posdef( akeep, fkeep, d ) + TYPE( slblt_akeep_type ), INTENT( IN ) :: akeep + CLASS( slblt_fkeep_type ), TARGET, INTENT( IN ) :: fkeep REAL( KIND = rp_ ), DIMENSION( * ), INTENT( OUT ) :: d ! local variables @@ -5078,20 +4800,20 @@ SUBROUTINE enquire_posdef_cpu( akeep, fkeep, d ) en = akeep%part( part + 1 ) - 1 ASSOCIATE( subtree => fkeep%subtree( part )%ptr ) SELECT TYPE( subtree ) - TYPE IS ( cpu_numeric_subtree ) + TYPE IS ( numeric_subtree ) CALL subtree%enquire_posdef( d( sa : en ) ) END SELECT END ASSOCIATE END DO - END SUBROUTINE enquire_posdef_cpu + END SUBROUTINE enquire_posdef -!-*- G A L A H A D - S S I D S _ enquire_indef_cpu S U B R O U T I N E -*- +!-*- G A L A H A D - S L B L T _ enquire_indef S U B R O U T I N E -*- - SUBROUTINE enquire_indef_cpu( akeep, fkeep, inform, piv_order, d ) - TYPE( ssids_akeep_type ), INTENT( IN ) :: akeep - CLASS( ssids_fkeep_type ), TARGET, INTENT( IN ) :: fkeep - TYPE( ssids_inform_type ), INTENT( INOUT ) :: inform + SUBROUTINE enquire_indef( akeep, fkeep, inform, piv_order, d ) + TYPE( slblt_akeep_type ), INTENT( IN ) :: akeep + CLASS( slblt_fkeep_type ), TARGET, INTENT( IN ) :: fkeep + TYPE( slblt_inform_type ), INTENT( INOUT ) :: inform ! if i is used to index a variable, its position in the pivot sequence ! will be placed in piv_order(i), with its sign negative if it is @@ -5123,7 +4845,7 @@ SUBROUTINE enquire_indef_cpu( akeep, fkeep, inform, piv_order, d ) IF ( PRESENT( piv_order ) ) THEN ALLOCATE( po( akeep%n ), STAT = inform%stat ) IF ( inform%stat /= 0 ) THEN - inform%flag = SSIDS_ERROR_ALLOCATION + inform%flag = SLBLT_ERROR_ALLOCATION RETURN END IF END IF @@ -5135,7 +4857,7 @@ SUBROUTINE enquire_indef_cpu( akeep, fkeep, inform, piv_order, d ) sa = akeep%part( part ) ASSOCIATE( subtree => fkeep%subtree( 1 )%ptr ) SELECT TYPE( subtree ) - TYPE IS ( cpu_numeric_subtree ) + TYPE IS ( numeric_subtree ) IF ( PRESENT( d ) ) THEN IF ( PRESENT( piv_order ) ) THEN CALL subtree%enquire_indef( piv_order = po( sa : n ), & @@ -5146,7 +4868,6 @@ SUBROUTINE enquire_indef_cpu( akeep, fkeep, inform, piv_order, d ) ELSE IF ( PRESENT( piv_order ) ) THEN CALL subtree%enquire_indef( piv_order=po( sa:akeep%n ) ) - ELSE ! No-op: should we report an error here? (or done higher up?) END IF END IF END SELECT @@ -5163,11 +4884,11 @@ SUBROUTINE enquire_indef_cpu( akeep, fkeep, inform, piv_order, d ) END IF RETURN - END SUBROUTINE enquire_indef_cpu + END SUBROUTINE enquire_indef -!-*- G A L A H A D - S S I D S _ a l t e r _ c p u S U B R O U T I N E -*- +!-*- G A L A H A D - S L B L T _ a l t e r _ c p u S U B R O U T I N E -*- - SUBROUTINE alter_cpu( d, akeep, fkeep ) + SUBROUTINE alter( d, akeep, fkeep ) ! alter D values @@ -5175,31 +4896,34 @@ SUBROUTINE alter_cpu( d, akeep, fkeep ) ! and the off-diagonal entries must be placed in d(2,i) (i = 1,...n-1) REAL( KIND = rp_ ), DIMENSION( 2, * ), INTENT( IN ) :: d - TYPE( ssids_akeep_type ), INTENT( IN ) :: akeep - CLASS( ssids_fkeep_type ), TARGET, INTENT( INOUT ) :: fkeep + TYPE( slblt_akeep_type ), INTENT( IN ) :: akeep + CLASS( slblt_fkeep_type ), TARGET, INTENT( INOUT ) :: fkeep INTEGER( KIND = ip_ ) :: part DO part = 1, akeep%nparts ASSOCIATE( subtree => fkeep%subtree( 1 )%ptr ) SELECT TYPE( subtree ) - TYPE IS ( cpu_numeric_subtree ) - CALL subtree%alter( d( 1 : 2, akeep%part( part ) : & - akeep%part( part + 1 ) - 1 ) ) + TYPE IS ( numeric_subtree ) +! I believe that the next line is wrong as we should be pointing to +! an entry in memor, not to a submatrix +! CALL subtree%alter( d( 1 : 2, akeep%part( part ) : & +! akeep%part( part + 1 ) - 1 ) ) + CALL subtree%alter( d( 1, akeep%part( part ) ) ) END SELECT END ASSOCIATE END DO RETURN - END SUBROUTINE alter_cpu + END SUBROUTINE alter -!-*- G A L A H A D - S S I D S _ f r e e _ f k e e p S U B R O U T I N E -*- +!-*- G A L A H A D - S L B L T _ f r e e _ f k e e p S U B R O U T I N E -*- SUBROUTINE free_fkeep( fkeep, flag ) ! free all allocated components of the type fkeep - CLASS( ssids_fkeep_type ), INTENT( INOUT ) :: fkeep + CLASS( slblt_fkeep_type ), INTENT( INOUT ) :: fkeep ! not used for cpu version, set to 0 @@ -5209,7 +4933,7 @@ SUBROUTINE free_fkeep( fkeep, flag ) INTEGER( KIND = ip_ ) :: i, st -! not used for basic SSIDS, just set to zero +! not used for basic SLBLT, just set to zero flag = 0 @@ -5226,16 +4950,16 @@ SUBROUTINE free_fkeep( fkeep, flag ) END IF END SUBROUTINE free_fkeep -!-*-*- G A L A H A D - S S I D S _ final _ fkeep S U B R O U T I N E -*-*- +!-*-*- G A L A H A D - S L B L T _ final _ fkeep S U B R O U T I N E -*-*- SUBROUTINE final_fkeep( fkeep ) -! finalizer for SSIDS_fkeep_type. Ensures the C++ numeric subtrees (reached +! finalizer for SLBLT_fkeep_type. Ensures the numeric subtrees (reached ! only through the fkeep%subtree pointer array) are destroyed whenever an fkeep ! is deallocated, reset by an INTENT( OUT ) argument, or goes out of scope. ! See final_akeep for rationale; free_fkeep is a safe no-op if already freed. - TYPE( ssids_fkeep_type ), INTENT( INOUT ) :: fkeep + TYPE( slblt_fkeep_type ), INTENT( INOUT ) :: fkeep ! local variables @@ -5292,4 +5016,4 @@ END SUBROUTINE final_fkeep !!$ !!$ END SUBROUTINE writePPM - END MODULE GALAHAD_SSIDS_precision + END MODULE GALAHAD_SLBLT_precision diff --git a/src/slblt/slblt_factor.F90 b/src/slblt/slblt_factor.F90 new file mode 100644 index 0000000000..eb215ab821 --- /dev/null +++ b/src/slblt/slblt_factor.F90 @@ -0,0 +1,2512 @@ +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 16:40 GMT +! +! Pure-Fortran SLBLT factor/solve kernels + a serial multifrontal driver, +! in GALAHAD templated precision (GALAHAD ip_/rp_/long_ kinds). +! +! Contents: +! * calc_ld, ldlt_tpp_factor (+ helpers) -- dense block LDL^T (TPP) +! * block_ldlt (+ helpers) -- Bunch-Kaufman full block +! * ldlt_app_factor (+ helpers) -- a-posteriori pivoted +! (APP) blocked LDL^T +! * factor_node_indef -- node factor + contrib +! (APP if nb parent assembly +! * ldlt_app_solve_fwd/diag/bwd -- per-node solves +! * dmf_node, subtree_contrib_t -- multifrontal state +! * factor_subtree_delay -- factor including +! delayed pivots +! + foreign child_contrib +! * subtree_solve_fwd/diag/bwd_delay -- tree solves (multi-RHS) +! * extract_contrib -- produce a child_contrib +! +! These kernels are driven by GALAHAD_SLBLT_numeric_subtree_precision, which +! wires them into the SLBLT factorization/solve path. + +#include "galahad_modules.h" +#include "galahad_blas.h" +#include "galahad_lapack.h" + +!-*-*- G A L A H A D _ S L B L T _ F A C T O R M O D U L E -*-*-*-*- + + MODULE GALAHAD_SLBLT_factor_precision + USE GALAHAD_KINDS_precision, ONLY : ip_, rp_, long_ + USE, INTRINSIC :: IEEE_ARITHMETIC, ONLY : IEEE_VALUE, IEEE_POSITIVE_INF, & + IEEE_IS_FINITE + IMPLICIT NONE + PRIVATE + PUBLIC :: dmf_node, subtree_contrib_t, factor_subtree_delay, extract_contrib + PUBLIC :: subtree_solve_fwd_delay, subtree_solve_diag_delay, & + subtree_solve_bwd_delay + ! low-level kernels exposed for per-routine unit testing (slblt_factort) + PUBLIC :: calc_ld, ldlt_tpp_factor, ldlt_blocked_factor, factor_node_indef, & + block_ldlt, ldlt_app_factor, & + assemble_expected, assemble_expected_contrib, & + ldlt_app_solve_fwd, ldlt_app_solve_diag, ldlt_app_solve_bwd + + ! factor-routine return codes (the `flag` argument); 0 = success + INTEGER(ip_), PARAMETER :: FLAG_SINGULAR = -1 ! singular pivot/not definite + INTEGER(ip_), PARAMETER :: FLAG_OOM = -2 ! allocation failure + + TYPE subtree_contrib_t + INTEGER(ip_) :: cn = 0 + INTEGER(ip_) :: ndelay = 0 + INTEGER(ip_), ALLOCATABLE :: rlist(:) + INTEGER(ip_), ALLOCATABLE :: delay_perm(:) + REAL(rp_), ALLOCATABLE :: val(:,:) + REAL(rp_), ALLOCATABLE :: delay_val(:,:) + END TYPE subtree_contrib_t + + TYPE dmf_node + INTEGER(ip_) :: symb_ncol = 0, symb_nrow = 0, parent = 0 + INTEGER(ip_) :: ndelay_in = 0, ncol = 0, nrow = 0, ldl = 0 + INTEGER(ip_) :: nelim = 0, ndelay_out = 0 + INTEGER(ip_) :: nfirst = 0, nsecond = 0 ! cols not elim by 1st/2nd pass + INTEGER(ip_), ALLOCATABLE :: rlist(:), perm(:) + REAL(rp_), ALLOCATABLE :: lcol(:,:), d(:), contrib(:,:) + INTEGER(ip_), ALLOCATABLE :: ai(:), aj(:) + REAL(rp_), ALLOCATABLE :: av(:) + INTEGER(ip_), ALLOCATABLE :: contribs(:) + END TYPE dmf_node + + ! per-thread scratch reused across node tasks (avoids per-node allocation) + INTEGER(ip_), ALLOCATABLE :: tls_pmap(:) + !$omp threadprivate(tls_pmap) + + CONTAINS + +! ============================ calc_ld ================================== + + SUBROUTINE calc_ld(op_t, m, n, l, ldl, d, ld, ldld) + + LOGICAL, INTENT(IN) :: op_t + INTEGER(ip_), INTENT(IN) :: m, n, ldl, ldld + REAL(rp_), INTENT(IN) :: l(ldl, *), d(*) + REAL(rp_), INTENT(OUT) :: ld(ldld, *) + INTEGER(ip_) :: col, row + REAL(rp_) :: d11, d21, d22, det, a1, a2 + col = 0 + DO WHILE (col < n) + IF (col+1 == n .OR. IEEE_IS_FINITE(d(2*col+3))) THEN + d11 = d(2*col+1) + IF (d11 /= 0.0_rp_) d11 = 1.0_rp_/d11 + IF (.NOT. op_t) THEN + !$omp simd + DO row = 0, m-1 + ld(row+1, col+1) = d11 * l(row+1, col+1) + END DO + ELSE + DO row = 0, m-1 + ld(row+1, col+1) = d11 * l(col+1, row+1) + END DO + END IF + col = col + 1 + ELSE + d11 = d(2*col+1); d21 = d(2*col+2); d22 = d(2*col+4) + det = d11*d22 - d21*d21 + d11 = d11/det; d21 = d21/det; d22 = d22/det + DO row = 0, m-1 + IF (.NOT. op_t) THEN + a1 = l(row+1, col+1); a2 = l(row+1, col+2) + ELSE + a1 = l(col+1, row+1); a2 = l(col+2, row+1) + END IF + ld(row+1, col+1) = d22*a1 - d21*a2 + ld(row+1, col+2) = -d21*a1 + d11*a2 + END DO + col = col + 2 + END IF + END DO + + END SUBROUTINE calc_ld + +! ============================ ldlt_tpp ================================ + +! -- returns true if all entries in a column are less than small in abs value + + LOGICAL FUNCTION check_col_small(idx, from, to, a, lda, small) + INTEGER(ip_), INTENT(IN) :: idx, from, to, lda + REAL(rp_), INTENT(IN) :: a(lda, *), small + INTEGER(ip_) :: c, r + check_col_small = .TRUE. + DO c = from, idx-1 + check_col_small = check_col_small .AND. (ABS(a(idx+1, c+1)) < small) + END DO + DO r = idx, to-1 + check_col_small = check_col_small .AND. (ABS(a(r+1, idx+1)) < small) + END DO + END FUNCTION check_col_small + +! -- returns the column index of largest entry in row starting at a + + INTEGER(ip_) FUNCTION find_row_abs_max(from, to, prow, a, lda) & + RESULT(best_idx) + INTEGER(ip_), INTENT(IN) :: from, to, prow, lda + REAL(rp_), INTENT(IN) :: a(lda, *) + INTEGER(ip_) :: idx + REAL(rp_) :: best_val + IF (from >= to) THEN + best_idx = -1; RETURN + END IF + best_idx = from + best_val = ABS(a(prow+1, from+1)) + DO idx = from+1, to-1 + IF (ABS(a(prow+1, idx+1)) > best_val) THEN + best_idx = idx; best_val = ABS(a(prow+1, idx+1)) + END IF + END DO + + END FUNCTION find_row_abs_max + +! -- perform a symmetric swap of col1 and col2 in the lower triangle + + SUBROUTINE swap_cols(col1i, col2i, m, perm, a, lda, nleft, aleft, ldleft) + INTEGER(ip_), INTENT(IN) :: col1i, col2i, m, lda, nleft, ldleft + INTEGER(ip_), INTENT(INOUT) :: perm(*) + REAL(rp_), INTENT(INOUT) :: a(lda, *), aleft(ldleft, *) + INTEGER(ip_) :: col1, col2, c, i, r, itmp + REAL(rp_) :: rtmp + +! return if no swap is needed + + IF (col1i == col2i) RETURN + col1 = MIN(col1i, col2i); col2 = MAX(col1i, col2i) + +! swap permutation entries + + itmp = perm(col1+1); perm(col1+1) = perm(col2+1); perm(col2+1) = itmp + +! swap aleft(col1, :) and aleft(col2, :) + + DO c = 0, nleft-1 + rtmp = aleft(col1+1, c+1) + aleft(col1+1, c+1) = aleft(col2+1, c+1); aleft(col2+1, c+1) = rtmp + END DO + +! swap a(col1, 0:col1-1) and a(col2, 0:col1-1) + + DO c = 0, col1-1 + rtmp = a(col1+1, c+1); a(col1+1, c+1) & + = a(col2+1, c+1); a(col2+1, c+1) = rtmp + END DO + +! swap a(col1+1:col2-1, col1) and a(col2, col1+1:col2-1) + + DO i = col1+1, col2-1 + rtmp = a(i+1, col1+1); a(i+1, col1+1) & + = a(col2+1, i+1); a(col2+1, i+1) = rtmp + END DO + +! swap a(col2+1:m, col1) and a(col2+1:m, col2) + + DO r = col2+1, m-1 + rtmp = a(r+1, col1+1) + a(r+1, col1+1) = a(r+1, col2+1); a(r+1, col2+1) = rtmp + END DO + +! swap a(col1, col1) and a(col2, col2) + + rtmp = a(col1+1, col1+1); a(col1+1, col1+1) = a(col2+1, col2+1) + a(col2+1, col2+1) = rtmp + + END SUBROUTINE swap_cols + +! -- returns the absolute value of the largest unelimited entry in +! row/column not in position exclude or on the diagonal + + REAL(rp_) FUNCTION find_rc_abs_max_exclude(col, nelim, m, a, lda, exclude) & + RESULT(best) + + INTEGER(ip_), INTENT(IN) :: col, nelim, m, lda, exclude + REAL(rp_), INTENT(IN) :: a(lda, *) + INTEGER(ip_) :: c, r + best = 0.0_rp_ + DO c = nelim, col-1 + IF (c == exclude) CYCLE + best = MAX(best, ABS(a(col+1, c+1))) + END DO + DO r = col+1, m-1 + IF (r == exclude) CYCLE + best = MAX(best, ABS(a(r+1, col+1))) + END DO + + END FUNCTION find_rc_abs_max_exclude + +! return true if (t,p) is a good 2x2 pivot, false otherwise + + LOGICAL FUNCTION test_2x2(t, p, maxt, maxp, a, lda, u, small, d, nelim) & + RESULT(ok) + INTEGER(ip_), INTENT(IN) :: t, p, lda, nelim + REAL(rp_), INTENT(IN) :: maxt, maxp, a(lda, *), u, small + REAL(rp_), INTENT(INOUT) :: d(*) + REAL(rp_) :: a11, a21, a22, detpiv, detpiv0, detpiv1, detscale + REAL(rp_) :: maxpiv, x1, x2 + +! check there is a non-zero in the pivot block (NB: We know t < p) + + a11 = a(t+1, t+1); a21 = a(p+1, t+1); a22 = a(p+1, p+1) + maxpiv = MAX(ABS(a11), ABS(a21), ABS(a22)) + ok = .FALSE. + IF (maxpiv < small) RETURN + +! ensure non-singular and not afflicted by cancellation + + detscale = 1.0_rp_ / maxpiv + detpiv0 = (a11*detscale)*a22 + detpiv1 = (a21*detscale)*a21 + detpiv = detpiv0 - detpiv1 + IF (ABS(detpiv) < MAX(small, MAX(ABS(detpiv0/2), ABS(detpiv1/2)))) RETURN + +! finally apply the threshold pivot check + + d(2*nelim+1) = (a22*detscale)/detpiv + d(2*nelim+2) = (-a21*detscale)/detpiv + d(2*nelim+3) = IEEE_VALUE(1.0_rp_, IEEE_POSITIVE_INF) + d(2*nelim+4) = (a11*detscale)/detpiv + IF (MAX(maxt, maxp) < small) THEN + ok = .TRUE.; RETURN + END IF + x1 = ABS(d(2*nelim+1))*maxt + ABS(d(2*nelim+2))*maxp + x2 = ABS(d(2*nelim+2))*maxt + ABS(d(2*nelim+4))*maxp + IF (u*MAX(x1, x2) < 1.0_rp_) ok = .TRUE. + END FUNCTION test_2x2 + +! -- apply the 2x2 pivot to rest of block colum + + SUBROUTINE apply_2x2(nelim, m, a, lda, ld, ldld, d) + INTEGER(ip_), INTENT(IN) :: nelim, m, lda, ldld + REAL(rp_), INTENT(INOUT) :: a(lda, *), ld(ldld, *) + REAL(rp_), INTENT(IN) :: d(*) + INTEGER(ip_) :: r + REAL(rp_) :: d11, d21, d22 + +! set the diagonal block to the identity + + a(nelim+1, nelim+1) = 1.0_rp_ + a(nelim+2, nelim+1) = 0.0_rp_ + a(nelim+2, nelim+2) = 1.0_rp_ + +! extract the values of D^-1 + + d11 = d(2*nelim+1); d21 = d(2*nelim+2); d22 = d(2*nelim+4) + +! divide through, preserving a copy in ld + + !$omp simd + DO r = nelim+2, m-1 + ld(r+1, 1) = a(r+1, nelim+1) + ld(r+1, 2) = a(r+1, nelim+2) + a(r+1, nelim+1) = d11*ld(r+1, 1) + d21*ld(r+1, 2) + a(r+1, nelim+2) = d21*ld(r+1, 1) + d22*ld(r+1, 2) + END DO + END SUBROUTINE apply_2x2 + +! -- apply the 1x1 pivot to the rest of the block column + + SUBROUTINE apply_1x1(nelim, m, a, lda, ld, ldld, d) + INTEGER(ip_), INTENT(IN) :: nelim, m, lda, ldld + REAL(rp_), INTENT(INOUT) :: a(lda, *), ld(ldld, *) + REAL(rp_), INTENT(IN) :: d(*) + INTEGER(ip_) :: r + REAL(rp_) :: d11 + +! set the diagonal block to the identity + + a(nelim+1, nelim+1) = 1.0_rp_ + +! extract the values of D^-1 + + d11 = d(2*nelim+1) + +! divide through, preserving a copy in ld + + !$omp simd + DO r = nelim+1, m-1 + ld(r+1, 1) = a(r+1, nelim+1) + a(r+1, nelim+1) = d11*a(r+1, nelim+1) + END DO + END SUBROUTINE apply_1x1 + +! -- sets a column to zero + + SUBROUTINE zero_col(col, m, a, lda) + INTEGER(ip_), INTENT(IN) :: col, m, lda + REAL(rp_), INTENT(INOUT) :: a(lda, *) + INTEGER(ip_) :: r + DO r = col, m-1 + a(r+1, col+1) = 0.0_rp_ + END DO + END SUBROUTINE zero_col + +! -- a simple LDL^T factorization with threshold partial pivoting. +! This is intended for finishing off small matrices, not for performance + + FUNCTION ldlt_tpp_factor(m, n, perm, a, lda, d, ld, ldld, action, u, small, & + nleft, aleft, ldleft, flag) RESULT(nelim) + INTEGER(ip_), INTENT(IN) :: m, n, lda, ldld, nleft, ldleft + INTEGER(ip_), INTENT(INOUT) :: perm(*) + REAL(rp_), INTENT(INOUT) :: a(lda, *), d(*), ld(ldld, *) + REAL(rp_), INTENT(INOUT) :: aleft(ldleft, *) + LOGICAL, INTENT(IN) :: action + REAL(rp_), INTENT(IN) :: u, small + INTEGER(ip_), INTENT(OUT) :: flag + INTEGER(ip_) :: nelim + INTEGER(ip_) :: p, t + REAL(rp_) :: maxt, maxp +!write(6,*) ' m, n ', m, n, lda +! nelim is the number of eliminated variables + + nelim = 0; flag = 0 + DO WHILE (nelim < n) + +! need to check if col nelim is zero now or it gets missed + + IF (check_col_small(nelim, nelim, m, a, lda, small)) THEN + +! record a zero pivot + + IF (.NOT. action) THEN + flag = FLAG_SINGULAR; RETURN ! singular, action=.FALSE., abort + END IF + CALL swap_cols(nelim, nelim, m, perm, a, lda, nleft, aleft, ldleft) + CALL zero_col(nelim, m, a, lda) + d(2*nelim+1) = 0.0_rp_; d(2*nelim+2) = 0.0_rp_ + nelim = nelim + 1; CYCLE + END IF + +! p is the index of current candidate pivot [starts at col 2] + + DO p = nelim+1, n-1 + +! check if column p is effectively zero + + IF (check_col_small(p, nelim, m, a, lda, small)) THEN + +! record a zero pivot + + IF (.NOT. action) THEN + flag = FLAG_SINGULAR; RETURN ! singular, action=.FALSE., abort + END IF + CALL swap_cols(p, nelim, m, perm, a, lda, nleft, aleft, ldleft) + CALL zero_col(nelim, m, a, lda) + d(2*nelim+1) = 0.0_rp_; d(2*nelim+2) = 0.0_rp_ + nelim = nelim + 1; EXIT + END IF + +! find a column index t of largest entry in |a(p, nelim+1:p-1)| + + t = find_row_abs_max(nelim, p, p, a, lda) + +! try (t,p) as a 2x2 pivot + + maxt = find_rc_abs_max_exclude(t, nelim, m, a, lda, p) + maxp = find_rc_abs_max_exclude(p, nelim, m, a, lda, t) + IF (test_2x2(t, p, maxt, maxp, a, lda, u, small, d, nelim)) THEN +!write(6,*) "2x2 pivot" + CALL swap_cols(t, nelim, m, perm, a, lda, nleft, aleft, ldleft) + CALL swap_cols(p, nelim+1, m, perm, a, lda, nleft, aleft, ldleft) + CALL apply_2x2(nelim, m, a, lda, ld, ldld, d) + CALL DGEMM('N', 'T', m-nelim-2, n-nelim-2, 2_ip_, -1.0_rp_, & + a(nelim+3, nelim+1), lda, ld(nelim+3, 1), ldld, 1.0_rp_, & + a(nelim+3, nelim+3), lda) + nelim = nelim + 2; EXIT + END IF + +! try p as a 1x1 pivot + + maxp = MAX(maxp, ABS(a(p+1, t+1))) + IF (ABS(a(p+1, p+1)) >= u*maxp) THEN +!write(6,*) "1x1 pivot" + CALL swap_cols(p, nelim, m, perm, a, lda, nleft, aleft, ldleft) + d(2*nelim+1) = 1.0_rp_ / a(nelim+1, nelim+1) + d(2*nelim+2) = 0.0_rp_ + CALL apply_1x1(nelim, m, a, lda, ld, ldld, d) + CALL DGEMM('N', 'T', m-nelim-1, n-nelim-1, 1_ip_, -1.0_rp_, & + a(nelim+2, nelim+1), lda, ld(nelim+2, 1), ldld, 1.0_rp_, & + a(nelim+2, nelim+2), lda) + nelim = nelim + 1; EXIT + END IF + END DO + +! the pivot search failed. Try a 1x1 pivot on p=nelim as the last resort +! (recall, we started at p=nelim+1) + + IF (p >= n) THEN + p = nelim + maxp = find_rc_abs_max_exclude(p, nelim, m, a, lda, -1_ip_) + IF (ABS(a(p+1, p+1)) >= u*maxp) THEN +!write(6,*) "1x1 emergency pivot" + CALL swap_cols(p, nelim, m, perm, a, lda, nleft, aleft, ldleft) + d(2*nelim+1) = 1.0_rp_ / a(nelim+1, nelim+1) + d(2*nelim+2) = 0.0_rp_ + CALL apply_1x1(nelim, m, a, lda, ld, ldld, d) +!write(6,*) m-nelim-1, nelim+1, a(nelim+1, nelim+1) + IF ( nelim < n - 1 ) & + CALL DGEMM('N', 'T', m-nelim-1, n-nelim-1, 1_ip_, -1.0_rp_, & + a(nelim+1, nelim+1), lda, ld(nelim+2, 1), ldld, 1.0_rp_, & + a(nelim+1, nelim+2), lda) +! a(nelim+2, nelim+1), lda, ld(nelim+2, 1), ldld, 1.0_rp_, & +! a(nelim+2, nelim+2), lda) + nelim = nelim + 1 + ELSE + +! that didn't work either. No more pivots to be found + + EXIT + END IF + END IF + END DO + END FUNCTION ldlt_tpp_factor + +! ========================= ldlt_blocked ============================== + !> Blocked RIGHT-looking LDL^T-TPP with intra-front OpenMP parallelism -- + !! the practical core of the block LDL^T. Each block column (width nb) is + !! factored by ldlt_tpp (identical threshold pivoting), then the INDEPENDENT + !! trailing block-column updates are run as !$omp tasks, so a single large + !! front is factored in parallel. The tasks bind to the enclosing team + !! (the tree DAG in factor_subtree_delay) so they compose without + !! oversubscription; with no enclosing parallel region they run serially. + !! A delayed pivot finishes the tail with a full ldlt_tpp (delays match the + !! unblocked kernel). nb >= n reduces to a single unblocked call. + + FUNCTION ldlt_blocked_factor(m, n, perm, a, lda, d, u, small, action, nb, & + flag) RESULT(nelim) + INTEGER(ip_), INTENT(IN) :: m, n, lda, nb + INTEGER(ip_), INTENT(INOUT) :: perm(*) + REAL(rp_), INTENT(INOUT) :: a(lda, *), d(*) + REAL(rp_), INTENT(IN) :: u, small + LOGICAL, INTENT(IN) :: action + INTEGER(ip_), INTENT(OUT) :: flag + INTEGER(ip_) :: nelim + INTEGER(ip_) :: ps, pe, kf, nrem, js, je + REAL(rp_), ALLOCATABLE :: ldw(:, :) + nelim = 0; flag = 0; ps = 0 + DO WHILE (ps < n) + pe = MIN(ps + nb, n) + ! factor the tall panel [ps:m, ps:pe] (up to date -- right-looking) + ALLOCATE(ldw(m-ps, 2)) + kf = ldlt_tpp_factor(m-ps, pe-ps, perm(ps+1), a(ps+1, ps+1), lda, & + d(2*ps+1), ldw, m-ps, action, u, small, ps, & + a(ps+1, 1), lda, flag) + DEALLOCATE(ldw) + nelim = nelim + kf + IF (flag /= 0) RETURN + IF (kf < pe - ps) THEN + ! delayed pivot: bring the untouched trailing up to date, finish tail + IF (pe < n) THEN + nrem = n - pe + CALL update_trailing_block(m, ps, pe, n, a, lda, d, nelim) + ALLOCATE(ldw(m-nelim, 2)) + kf = ldlt_tpp_factor(m-nelim, n-nelim, perm(nelim+1), & + a(nelim+1, nelim+1), lda, d(2*nelim+1), & + ldw, m-nelim, action, u, small, nelim, & + a(nelim+1, 1), lda, flag) + DEALLOCATE(ldw) + nelim = nelim + kf + END IF + RETURN + END IF + ! right-looking: update each trailing block column [pe,n) independently + DO js = pe, n-1, nb + je = MIN(js + nb, n) + !$omp task default(shared) firstprivate(js, je) if(n-pe > nb) + CALL update_trailing_block(m, ps, js, je, a, lda, d, nelim) + !$omp end task + END DO + !$omp taskwait + ps = pe + END DO + END FUNCTION ldlt_blocked_factor + + !> Trailing update of block column [cs,ce) by the pivots [ps0,nelim): + !! a[cs:m, cs:ce] -= L[cs:m, ps0:nelim] * D * L[cs:ce, ps0:nelim]^T. + SUBROUTINE update_trailing_block(m, ps0, cs, ce, a, lda, d, nelim) + INTEGER(ip_), INTENT(IN) :: m, ps0, cs, ce, lda, nelim + REAL(rp_), INTENT(INOUT) :: a(lda, *) + REAL(rp_), INTENT(IN) :: d(*) + INTEGER(ip_) :: k, cw + REAL(rp_), ALLOCATABLE :: ld2(:, :) + k = nelim - ps0 + IF (k <= 0) RETURN + cw = ce - cs + ALLOCATE(ld2(cw, k)) + CALL calc_ld(.FALSE., cw, k, a(cs+1, ps0+1), lda, d(2*ps0+1), ld2, cw) + CALL DGEMM('N', 'T', m-cs, cw, k, -1.0_rp_, a(cs+1, ps0+1), lda, ld2, cw, & + 1.0_rp_, a(cs+1, cs+1), lda) + DEALLOCATE(ld2) + END SUBROUTINE update_trailing_block + +! ===================== block_ldlt + a-posteriori pivoted (APP) ========= +!====================== block_ldlt (validated) ========================== + SUBROUTINE bk_find_maxloc(from, a, lda, bs, bestv, rloc, cloc) + INTEGER(ip_), INTENT(IN) :: from, lda, bs + REAL(rp_), INTENT(IN) :: a(lda,*) + REAL(rp_), INTENT(OUT) :: bestv + INTEGER(ip_), INTENT(OUT) :: rloc, cloc + INTEGER(ip_) :: c, r + REAL(rp_) :: bv, cmax + ! per-column max reduction (vectorisable) + scalar locate of the first row + ! achieving it; identical (c,r) tie-break to the scalar double loop. + bv = -1.0_rp_; rloc = bs; cloc = bs + DO c = from, bs-1 + cmax = -1.0_rp_ + !$omp simd reduction(max: cmax) + DO r = c, bs-1 + cmax = MAX(cmax, ABS(a(r+1, c+1))) + END DO + IF (cmax > bv) THEN + DO r = c, bs-1 + IF (ABS(a(r+1, c+1)) == cmax) THEN + bv = cmax; rloc = r; cloc = c; EXIT + END IF + END DO + END IF + END DO + IF (cloc < bs .AND. rloc < bs) THEN + bestv = a(rloc+1, cloc+1) + ELSE + bestv = 0.0_rp_ + END IF + END SUBROUTINE bk_find_maxloc + + LOGICAL FUNCTION bk_test_2x2(a11, a21, a22, detpiv, detscale) RESULT(ok) + REAL(rp_), INTENT(IN) :: a11, a21, a22 + REAL(rp_), INTENT(OUT) :: detpiv, detscale + detscale = 1.0_rp_/ABS(a21) + detpiv = (a11*detscale)*a22 - ABS(a21) + ok = (ABS(detpiv) >= ABS(a21)/2.0_rp_) + END FUNCTION bk_test_2x2 + + SUBROUTINE bk_swap_cols(idx1i, idx2i, n, a, lda, ldwork, bs, perm) + INTEGER(ip_), INTENT(IN) :: idx1i, idx2i, n, lda, bs + REAL(rp_), INTENT(INOUT) :: a(lda,*), ldwork(bs,*) + INTEGER(ip_), INTENT(INOUT) :: perm(*) + INTEGER(ip_) :: idx1, idx2, c, i, r, it + REAL(rp_) :: t + IF (idx1i == idx2i) RETURN + idx1 = MIN(idx1i, idx2i); idx2 = MAX(idx1i, idx2i) + it = perm(idx1+1); perm(idx1+1) = perm(idx2+1); perm(idx2+1) = it + DO c = 0, idx1-1 + t = ldwork(idx1+1, c+1); ldwork(idx1+1, c+1) = ldwork(idx2+1, c+1) + ldwork(idx2+1, c+1) = t + END DO + DO c = 0, idx1-1 + t = a(idx1+1, c+1); a(idx1+1, c+1) = a(idx2+1, c+1); a(idx2+1, c+1) = t + END DO + DO i = idx1+1, idx2-1 + t = a(i+1, idx1+1); a(i+1, idx1+1) = a(idx2+1, i+1); a(idx2+1, i+1) = t + END DO + t = a(idx1+1, idx1+1); a(idx1+1, idx1+1) = a(idx2+1, idx2+1) + a(idx2+1, idx2+1) = t + DO r = idx2+1, n-1 + t = a(r+1, idx1+1); a(r+1, idx1+1) = a(r+1, idx2+1); a(r+1, idx2+1) = t + END DO + END SUBROUTINE bk_swap_cols + + SUBROUTINE bk_update_1x1(p, a, lda, ldw, bs) + INTEGER(ip_), INTENT(IN) :: p, lda, bs + REAL(rp_), INTENT(INOUT) :: a(lda,*) + REAL(rp_), INTENT(IN) :: ldw(bs,*) + INTEGER(ip_) :: c, r + DO c = p+1, bs-1 + !$omp simd + DO r = c, bs-1 + a(r+1, c+1) = a(r+1, c+1) - ldw(c+1, p+1)*a(r+1, p+1) + END DO + END DO + END SUBROUTINE bk_update_1x1 + + SUBROUTINE bk_update_2x2(p, a, lda, ldw, bs) + INTEGER(ip_), INTENT(IN) :: p, lda, bs + REAL(rp_), INTENT(INOUT) :: a(lda,*) + REAL(rp_), INTENT(IN) :: ldw(bs,*) + INTEGER(ip_) :: c, r + DO c = p+2, bs-1 + !$omp simd + DO r = c, bs-1 + a(r+1, c+1) = a(r+1, c+1) - ldw(c+1, p+1)*a(r+1, p+1) & + - ldw(c+1, p+2)*a(r+1, p+2) + END DO + END DO + END SUBROUTINE bk_update_2x2 + + SUBROUTINE block_ldlt(from, perm, a, lda, d, ldwork, action, u, small, & + lperm, bs, flag) + INTEGER(ip_), INTENT(IN) :: from, lda, bs + INTEGER(ip_), INTENT(INOUT) :: perm(*), lperm(*) + REAL(rp_), INTENT(INOUT) :: a(lda,*), d(*), ldwork(bs,*) + LOGICAL, INTENT(IN) :: action + REAL(rp_), INTENT(IN) :: u, small + INTEGER(ip_), INTENT(OUT) :: flag + INTEGER(ip_) :: p, t, m, r, it, pivsiz + REAL(rp_) :: bestv, a11, a21, a22, detscale, detpiv, d11, d21, d22 + flag = 0 + p = from + DO WHILE (p < bs) + CALL bk_find_maxloc(p, a, lda, bs, bestv, t, m) + IF (ABS(bestv) < small) THEN + IF (.NOT. action) THEN + flag = FLAG_SINGULAR; RETURN ! singular pivot, action=.FALSE., abort + END IF + DO WHILE (p < bs) + d(2*p+1) = 0.0_rp_; d(2*p+2) = 0.0_rp_ + DO r = p, bs-1 + a(r+1, p+1) = 0.0_rp_ + END DO + DO r = p, bs-1 + ldwork(r+1, p+1) = 0.0_rp_ + END DO + p = p + 1 + END DO + EXIT + END IF + pivsiz = 0 + IF (t == m) THEN + a11 = a(t+1, t+1); pivsiz = 1 + ELSE + a11 = a(m+1, m+1); a22 = a(t+1, t+1); a21 = a(t+1, m+1) + IF (bk_test_2x2(a11, a21, a22, detpiv, detscale)) THEN + pivsiz = 2 + ELSE + IF (ABS(a11) > ABS(a22)) THEN + pivsiz = 1; t = m + IF (ABS(a11/a21) < u) pivsiz = 0 + ELSE + pivsiz = 1; a11 = a22; m = t + IF (ABS(a22/a21) < u) pivsiz = 0 + END IF + END IF + END IF + IF (pivsiz == 0) THEN + flag = FLAG_SINGULAR; RETURN + ELSE IF (pivsiz == 1) THEN + d11 = 1.0_rp_/a11 + CALL bk_swap_cols(p, t, bs, a, lda, ldwork, bs, perm) + it = lperm(p+1); lperm(p+1) = lperm(t+1); lperm(t+1) = it + DO r = p+1, bs-1 + ldwork(r+1, p+1) = a(r+1, p+1) + a(r+1, p+1) = a(r+1, p+1)*d11 + END DO + CALL bk_update_1x1(p, a, lda, ldwork, bs) + d(2*p+1) = d11; d(2*p+2) = 0.0_rp_ + a(p+1, p+1) = 1.0_rp_ + ELSE + CALL bk_swap_cols(p, m, bs, a, lda, ldwork, bs, perm) + it = lperm(p+1); lperm(p+1) = lperm(m+1); lperm(m+1) = it + CALL bk_swap_cols(p+1, t, bs, a, lda, ldwork, bs, perm) + it = lperm(p+2); lperm(p+2) = lperm(t+1); lperm(t+1) = it + d11 = (a22*detscale)/detpiv + d22 = (a11*detscale)/detpiv + d21 = (-a21*detscale)/detpiv + DO r = p+2, bs-1 + ldwork(r+1, p+1) = a(r+1, p+1) + ldwork(r+1, p+2) = a(r+1, p+2) + a(r+1, p+1) = d11*ldwork(r+1, p+1) + d21*ldwork(r+1, p+2) + a(r+1, p+2) = d21*ldwork(r+1, p+1) + d22*ldwork(r+1, p+2) + END DO + CALL bk_update_2x2(p, a, lda, ldwork, bs) + d(2*p+1) = d11; d(2*p+2) = d21 + d(2*p+3) = IEEE_VALUE(1.0_rp_, IEEE_POSITIVE_INF) + d(2*p+4) = d22 + a(p+1, p+1) = 1.0_rp_; a(p+2, p+1) = 0.0_rp_; a(p+2, p+2) = 1.0_rp_ + END IF + p = p + pivsiz + END DO + END SUBROUTINE block_ldlt + +!====================== apply_pivot / check_threshold =================== + + ! Faithful port of apply_pivot (ldlt_app.cxx). diag is the + ! (permuted, factored) diagonal block base; d its packed inverse pivots. + ! Performs solve with diagonal block L_{21} = A_{21} L_{11}^{-T} D_1^{-1}. + ! Designed for below diagonal. NB: d stores (inverted) pivots as follows: + ! 2x2 ( a b ) stored as d = [ a b Inf c ] + ! ( b c ) + ! 1x1 ( a ) stored as d = [ a 0.0 ] + ! 1x1 ( 0 ) stored as d = [ 0.0 0.0 ] + + SUBROUTINE app_apply_pivot(op_t, m, n, ifrom, diag, ldd, d, small, a, lda) + LOGICAL, INTENT(IN) :: op_t ! (apply the transpose) + INTEGER(ip_), INTENT(IN) :: m, n, ifrom, ldd, lda + REAL(rp_), INTENT(IN) :: diag(ldd,*), d(*), small + REAL(rp_), INTENT(INOUT) :: a(lda,*) + INTEGER(ip_) :: i, j + REAL(rp_) :: d11, d21, d22, a1, a2, v + +! perform solve L_11^-T + + IF (.NOT. op_t) THEN + IF (ifrom > m .OR. m <= 0 .OR. n <= 0) RETURN + CALL DTRSM('R', 'L', 'T', 'U', m, n, 1.0_rp_, diag, ldd, a, lda) + +! perform solve L_21 D^-1 + + i = 0 + DO WHILE (i < n) + IF (i+1 == n .OR. IEEE_IS_FINITE(d(2*i+3))) THEN + d11 = d(2*i+1) + +! 1x1 pivot + + IF (d11 == 0.0_rp_) THEN ! handle zero pivots carefully + DO j = 1, m + v = a(j, i+1) + IF (ABS(v) < small) THEN + a(j, i+1) = 0.0_rp_ + ELSE + a(j, i+1) = IEEE_VALUE(1.0_rp_, IEEE_POSITIVE_INF)*v + END IF + END DO + ELSE ! non-zero pivot, apply in normal fashion + DO j = 1, m + a(j, i+1) = a(j, i+1)*d11 + END DO + END IF + i = i + 1 + +! 2x2 pivot + + ELSE + d11 = d(2*i+1); d21 = d(2*i+2); d22 = d(2*i+4) + DO j = 1, m + a1 = a(j, i+1); a2 = a(j, i+2) + a(j, i+1) = d11*a1 + d21*a2 + a(j, i+2) = d21*a1 + d22*a2 + END DO + i = i + 2 + END IF + END DO + +! Perform solve L_11^-1 + + ELSE + IF (ifrom > n .OR. m <= 0 .OR. n-ifrom <= 0) RETURN + CALL DTRSM('L', 'L', 'N', 'U', m, n-ifrom, 1.0_rp_, diag, ldd, & + a(1, ifrom+1), lda) + +! perform solve D^-T L_21^T + + i = 0 + DO WHILE (i < m) + IF (i+1 == m .OR. IEEE_IS_FINITE(d(2*i+3))) THEN + d11 = d(2*i+1) + +! 1x1 pivot + + IF (d11 == 0.0_rp_) THEN ! handle zero pivots carefully + DO j = ifrom, n-1 + v = a(i+1, j+1) + IF (ABS(v) < small) THEN + a(i+1, j+1) = 0.0_rp_ + ELSE + a(i+1, j+1) = IEEE_VALUE(1.0_rp_, IEEE_POSITIVE_INF)*v + END IF + END DO + ELSE ! non-zero pivot, apply in normal fashion + DO j = ifrom, n-1 + a(i+1, j+1) = a(i+1, j+1)*d11 + END DO + END IF + i = i + 1 + +! 2x2 pivot + + ELSE + d11 = d(2*i+1); d21 = d(2*i+2); d22 = d(2*i+4) + DO j = ifrom, n-1 + a1 = a(i+1, j+1); a2 = a(i+2, j+1) + a(i+1, j+1) = d11*a1 + d21*a2 + a(i+2, j+1) = d21*a1 + d22*a2 + END DO + i = i + 2 + END IF + END DO + END IF + END SUBROUTINE app_apply_pivot + + INTEGER(ip_) FUNCTION app_check_threshold(op_t, rfrom, rto, cfrom, cto, u, & + a, lda) RESULT(least_fail) + LOGICAL, INTENT(IN) :: op_t + INTEGER(ip_), INTENT(IN) :: rfrom, rto, cfrom, cto, lda + REAL(rp_), INTENT(IN) :: u, a(lda,*) + INTEGER(ip_) :: i, j + LOGICAL :: brk + IF (.NOT. op_t) THEN + least_fail = cto + ELSE + least_fail = rto + END IF + DO j = cfrom, cto-1 + brk = .FALSE. + DO i = rfrom, rto-1 + IF (ABS(a(i+1, j+1)) > 1.0_rp_/u) THEN + IF (.NOT. op_t) THEN + least_fail = j; RETURN + ELSE + least_fail = MIN(least_fail, i); brk = .TRUE.; EXIT + END IF + END IF + END DO + IF (brk) CYCLE + END DO + END FUNCTION app_check_threshold + +!====================== the serial APP driver =========================== + ! Drop-in replacement for ldlt_blocked_factor: factor the m x n panel a(lda,*) + ! (n fully-summed cols, rows n+1..m are contribution rows) with a-posteriori + ! pivoting at block size bs (= INNER_BLOCK_SIZE). On exit a holds the packed + ! factorization: eliminated cols [1,nelim] contiguous with unit-L; failed + ! (delayed) cols [nelim+1,n] hold the Schur complement; d packed inverse + ! pivots; perm the (block) permutation. + RECURSIVE FUNCTION ldlt_app_factor(m, n, perm, a, lda, d, u, small, action, & + bs, flag, use_tasks, aggressive) RESULT(num_elim) + INTEGER(ip_), INTENT(IN) :: m, n, lda, bs + INTEGER(ip_), INTENT(INOUT) :: perm(*) + REAL(rp_), INTENT(INOUT) :: a(lda,*), d(*) + REAL(rp_), INTENT(IN) :: u, small + LOGICAL, INTENT(IN) :: action + INTEGER(ip_), INTENT(OUT) :: flag + LOGICAL, INTENT(IN), OPTIONAL :: use_tasks, aggressive + INTEGER(ip_) :: num_elim + INTEGER(ip_), PARAMETER :: INNER = 32 ! inner block size + ! (block_ldlt granularity) + LOGICAL :: lut, aggr + INTEGER(ip_) :: nblk, mblk, iblk, jblk, next_elim, i, j, nc + INTEGER(ip_) :: nfail, ldc, from_blk, nu, uflag, ast + INTEGER(ip_), ALLOCATABLE :: cnelim(:), cdoff(:), cnpass(:), lperm(:,:) + INTEGER(ip_), ALLOCATABLE :: fperm(:), perm_copy(:), up2d(:,:) + LOGICAL, ALLOCATABLE :: cfirst(:) + REAL(rp_), ALLOCATABLE :: bcopy(:,:), fdiag(:,:), frect(:,:) + INTEGER(ip_) :: insert, finsert, jf, jins, iins, ifl + LOGICAL :: aborted + + flag = 0 + lut = .TRUE.; IF (PRESENT(use_tasks)) lut = use_tasks + aggr = .FALSE.; IF (PRESENT(aggressive)) aggr = aggressive + nblk = (n-1)/bs + 1 + mblk = (m-1)/bs + 1 + ALLOCATE(cnelim(0:nblk-1), cdoff(0:nblk-1), cnpass(0:nblk-1) ) + ALLOCATE(cfirst(0:nblk-1)) + ALLOCATE(lperm(bs, 0:nblk-1)) + ALLOCATE(bcopy(m, n), stat=ast) ! O(m*n) -- guard against OOM + IF (ast /= 0) THEN + flag = FLAG_OOM; num_elim = -1 + DEALLOCATE(cnelim, cdoff, cnpass, cfirst, lperm) + RETURN + END IF + bcopy = 0.0_rp_ + cnelim = 0; cdoff = 0; cnpass = 0; cfirst = .FALSE. + next_elim = 0 + from_blk = 0 + aborted = .FALSE. + + ! ---- aggressive (APP_AGGRESSIVE): optimistic unpivoted attempt first ---- + ! The app_aggressive branch: try an unpivoted pass; on + ! success we are done; on a pivoting failure, roll back and resume the + ! careful pivoted pass from the first not-fully-accepted block column. + IF (aggr) THEN + bcopy(1:m, 1:n) = a(1:m, 1:n) ! full backup for restore + ALLOCATE(perm_copy(n)); perm_copy(1:n) = perm(1:n) + ALLOCATE(up2d(0:mblk-1, 0:nblk-1)); up2d = -1 + ! run the optimistic elimination + CALL run_unpivoted(m, n, perm, a, lda, d, u, small, action, bs, INNER, & + aggr, mblk, nblk, cnelim, cnpass, cfirst, cdoff, lperm, up2d, & + lut, nu, uflag) + IF (uflag /= 0 .OR. nu < 0) THEN + flag = MERGE(FLAG_OOM, FLAG_SINGULAR, uflag == FLAG_OOM); num_elim = -1 + DEALLOCATE(cnelim, cdoff, cnpass, cfirst, lperm, bcopy, perm_copy, up2d) + RETURN + END IF + IF (nu >= n) THEN + ! optimistic pass fully succeeded -- no failed columns, no compaction + num_elim = nu + DEALLOCATE(cnelim, cdoff, cnpass, cfirst, lperm, bcopy, perm_copy, up2d) + RETURN + END IF + ! partial failure: roll back and resume pivoted from block nelim_blk + from_blk = nu / bs + CALL restore_unpiv(from_blk, m, n, perm, a, lda, d, bs, mblk, nblk, & + cnelim, cdoff, lperm, bcopy, up2d, perm_copy) + next_elim = from_blk * bs + DEALLOCATE(perm_copy, up2d) + END IF + + ! Parallel a-posteriori pivoted elimination (port of run_elim_pivoted); the + ! OpenMP task DAG lives in run_pivoted. Aggressive resumes at from_blk. + CALL run_pivoted(m, n, perm, a, lda, d, u, small, action, bs, INNER, & + from_blk, mblk, nblk, cnelim, cnpass, cfirst, cdoff, lperm, bcopy, & + next_elim, lut, flag) + IF (flag /= 0) THEN + num_elim = -1 + DEALLOCATE(cnelim, cdoff, cnpass, cfirst, lperm, bcopy) + RETURN + END IF + num_elim = next_elim + + ! ================= post-elimination compaction ================== + IF (num_elim < n) THEN + nfail = n - num_elim + ! ---- move_back: build failed perm, compact eliminated perm ---- + ALLOCATE(fperm(nfail+1)); fperm = 0 ! +1: safe base addr for empty tail + insert = 0; finsert = 0 + DO jblk = 0, nblk-1 + nc = MIN(bs, n - jblk*bs) + CALL move_back(nc, cnelim(jblk), perm(jblk*bs+1), perm(insert+1), & + fperm(finsert+1)) + insert = insert + cnelim(jblk) + finsert = finsert + (nc - cnelim(jblk)) + END DO + DO i = 1, nfail + perm(num_elim+i) = fperm(i) + END DO + ! ---- copy_failed: extract failed diag+rect into temp buffers ---- + ldc = nfail + ALLOCATE(fdiag(nfail, n), frect(MAX(m-n,1), MAX(nfail,1)), stat=ast) + IF (ast /= 0) THEN ! OOM in the compaction buffers + flag = FLAG_OOM; num_elim = -1 + DEALLOCATE(cnelim, cdoff, cnpass, cfirst, lperm, bcopy) + IF (ALLOCATED(fperm)) DEALLOCATE(fperm) + RETURN + END IF + ! extract failed entriues of a + fdiag = 0.0_rp_; frect = 0.0_rp_ + jf = 0; jins = 0 + DO jblk = 0, nblk-1 + ifl = jf; iins = jins + ! diagonal part + DO iblk = jblk, nblk-1 + CALL copy_failed_diag(iblk, jblk, blk_ncol(iblk,n,bs), & + blk_ncol(jblk,n,bs), cnelim(iblk), cnelim(jblk), & + a, lda, fdiag, ldc, num_elim, nfail, jins, ifl, iins, jf, bs) + iins = iins + cnelim(iblk) + ifl = ifl + (blk_ncol(iblk,n,bs) - cnelim(iblk)) + END DO + ! rectangular part (rows >= n) + IF (m > n) THEN + CALL copy_failed_rect(jblk, cnelim(jblk), blk_ncol(jblk,n,bs), & + a, lda, frect, m-n, jf, n, m, bs) + END IF + jf = jf + (blk_ncol(jblk,n,bs) - cnelim(jblk)) + jins = jins + cnelim(jblk) + END DO + ! ---- move_up: compact eliminated columns' data ---- + jins = 0 + DO jblk = 0, nblk-1 + iins = jins + DO iblk = jblk, nblk-1 + CALL move_up_diag(iblk, jblk, cnelim(iblk), cnelim(jblk), & + a, lda, iins, jins, bs) + iins = iins + cnelim(iblk) + END DO + ! rect rows [n,m) + CALL move_up_rect_all(jblk, cnelim(jblk), a, lda, jins, n, m, bs) + jins = jins + cnelim(jblk) + END DO + ! ---- store failed entries back ---- + DO j = 0, n-1 + DO i = MAX(j, num_elim), n-1 + a(i+1, j+1) = fdiag(i-num_elim+1, j+1) + END DO + END DO + DO j = 0, nfail-1 + DO i = 0, m-n-1 + a(n+i+1, num_elim+j+1) = frect(i+1, j+1) + END DO + END DO + DEALLOCATE(fperm, fdiag, frect) + END IF + + DEALLOCATE(cnelim, cdoff, cnpass, cfirst, lperm, bcopy) + END FUNCTION ldlt_app_factor + + !> Parallel a-posteriori pivoted elimination (port of run_elim_pivoted): each + !! step is an OpenMP task; block-element depend() clauses form the DAG, so the + !! result is BIT-IDENTICAL to serial (with no OpenMP the directives collapse + !! to serial). APP_AGGRESSIVE resumes at from_blk after a rolled-back + !! optimistic unpivoted pass; otherwise from_blk = 0. flag returns 0 / + !! FLAG_SINGULAR / FLAG_OOM; next_elim accumulates the eliminated-pivot count + RECURSIVE SUBROUTINE run_pivoted(m, n, perm, a, lda, d, u, small, action, & + bs, inner, from_blk, mblk, nblk, cnelim, cnpass, cfirst, cdoff, lperm, & + bcopy, next_elim, lut, flag) + INTEGER(ip_), INTENT(IN) :: m, n, lda, bs, inner, from_blk, mblk, nblk + INTEGER(ip_), INTENT(INOUT) :: perm(*), next_elim + REAL(rp_), INTENT(INOUT) :: a(lda,*), d(*), bcopy(m,*) + REAL(rp_), INTENT(IN) :: u, small + LOGICAL, INTENT(IN) :: action, lut + INTEGER(ip_), INTENT(INOUT) :: cnelim(0:*), cnpass(0:*), cdoff(0:*) + INTEGER(ip_), INTENT(INOUT) :: lperm(bs, 0:*) + LOGICAL, INTENT(INOUT) :: cfirst(0:*) + INTEGER(ip_), INTENT(OUT) :: flag + INTEGER(ip_) :: blk, iblk, jblk, adr, adc + INTEGER(ip_) :: tnc, tnr, tdoff, tnelim, tlflag, tk, tbp, tnp + REAL(rp_) :: td11, td21, adum(1,1) + LOGICAL :: tfin, aborted + REAL(rp_), ALLOCATABLE :: tldw(:,:) + flag = 0; aborted = .FALSE. + !$omp taskgroup + DO blk = from_blk, nblk-1 + ! ---- factor diagonal ---- + !$omp task if(lut) default(shared) firstprivate(blk) & + !$omp private(tnc, tnr, tdoff, tnelim, tldw, tlflag, tk) & + !$omp depend(inout: a(blk*bs+1, blk*bs+1)) depend(inout: perm(blk*bs+1)) + IF (.NOT. aborted) THEN + tnc = MIN(bs, n - blk*bs); tnr = MIN(bs, m - blk*bs) + tdoff = 2*next_elim; cdoff(blk) = tdoff + CALL bkp_create(blk, blk, a, lda, bcopy, m, bs, m, n) + DO tk = 1, tnc + lperm(tk, blk) = tk-1 + END DO + IF (bs > INNER) THEN + ! recurse: factor the diagonal block with the inner APP (block_ldlt on + ! INNER-blocks + BLAS-3), inner runs serially. Outer keeps wide blocks + ! so the apply/update GEMMs are bs-wide. + tnelim = ldlt_app_factor(tnr, tnc, lperm(1,blk), & + a(blk*bs+1,blk*bs+1), lda, d(tdoff+1), & + u, small, action, INNER, tlflag, .FALSE.) + IF (tlflag /= 0) THEN + !$omp atomic write + aborted = .TRUE. + ! keep OOM(2) vs abort(1) + flag = MERGE(FLAG_OOM, FLAG_SINGULAR, tlflag == FLAG_OOM) + ELSE + CALL permute_blkperm(perm, blk, bs, tnc, lperm(1,blk)) + END IF + ELSE IF (tnc < bs) THEN + ALLOCATE(tldw(tnr+2, 2)) ! +2 rows: benign tail-DGEMM base addr + tnelim = ldlt_tpp_factor(tnr, tnc, lperm(1,blk), & + a(blk*bs+1,blk*bs+1), lda, d(tdoff+1), & + tldw, tnr+2, action, u, small, 0_ip_, adum, & + 1_ip_, tlflag) + DEALLOCATE(tldw) + IF (tlflag /= 0) THEN ! singular (flag<0) with action=.FALSE. + !$omp atomic write + aborted = .TRUE. + flag = FLAG_SINGULAR + ELSE + CALL permute_blkperm(perm, blk, bs, tnc, lperm(1,blk)) + END IF + ELSE + ALLOCATE(tldw(bs, bs)) + CALL block_ldlt(0_ip_, perm(blk*bs+1), a(blk*bs+1,blk*bs+1), lda, & + d(tdoff+1), tldw, action, u, small, lperm(1,blk), & + bs, tlflag) + DEALLOCATE(tldw); tnelim = bs + IF (tlflag /= 0) THEN ! singular (flag<0) with action=.FALSE. + !$omp atomic write + aborted = .TRUE. + flag = FLAG_SINGULAR + END IF + END IF + cnelim(blk) = tnelim ! raw block nelim (apply phase) + cnpass(blk) = tnelim ! init_passed(nelim) + END IF + !$omp end task + + ! ---- apply pivot to eliminated ROW (left blocks jblkblk) ---- + DO iblk = blk+1, mblk-1 + !$omp task if(lut) default(shared) firstprivate(blk, iblk) & + !$omp private(tbp) depend(in: a(blk*bs+1, blk*bs+1)) & + !$omp depend(inout: a(iblk*bs+1, blk*bs+1)) depend(in: perm(blk*bs+1)) + IF (.NOT. aborted) THEN + CALL bkp_cperm(iblk, blk, a, lda, bcopy, m, bs, n, lperm(1,blk)) + tbp = apply_N(iblk, blk, a, lda, d, cdoff, cnelim, m, n, bs, small, u) + !$omp atomic update + cnpass(blk) = MIN(cnpass(blk), tbp) + END IF + !$omp end task + END DO + + ! ---- adjust: avoid split 2x2, finalise nelim/next_elim ---- + !$omp task if(lut) default(shared) firstprivate(blk) & + !$omp private(tnp, td11, td21, tfin) depend(inout: perm(blk*bs+1)) + IF (.NOT. aborted) THEN + tnp = cnpass(blk) + IF (tnp > 0) THEN + td11 = d(cdoff(blk) + 2*(tnp-1) + 1) + td21 = d(cdoff(blk) + 2*(tnp-1) + 2) + tfin = IEEE_IS_FINITE(td11) + IF (tfin .AND. td21 /= 0.0_rp_) tnp = tnp - 1 + END IF + cfirst(blk) = (next_elim == 0 .AND. tnp > 0) + next_elim = next_elim + tnp + cnelim(blk) = tnp + END IF + !$omp end task + + ! ---- update trailing (left of elim col) ---- + DO jblk = 0, blk-1 + DO iblk = jblk, mblk-1 + IF (blk < iblk) THEN ! isrc dependency element (lower half) + adr = iblk*bs+1; adc = blk*bs+1 + ELSE + adr = blk*bs+1; adc = iblk*bs+1 + END IF + !$omp task if(lut) default(shared) firstprivate(blk, jblk, iblk) & + !$omp depend(inout: a(iblk*bs+1, jblk*bs+1)) & + !$omp depend(in: perm(blk*bs+1)) & + !$omp depend(in: a(blk*bs+1, jblk*bs+1)) depend(in: a(adr, adc)) + IF (.NOT. aborted) THEN + CALL restore_if_req(iblk, jblk, blk, a, lda, bcopy, m, bs, n, & + cnelim, lperm) + CALL update_left(iblk, jblk, blk, a, lda, d, cdoff, cnelim, m, & + n, bs) + END IF + !$omp end task + END DO + END DO + ! ---- update trailing (right of / at elim col) ---- + DO jblk = blk, nblk-1 + DO iblk = jblk, mblk-1 + !$omp task if(lut) default(shared) firstprivate(blk, jblk, iblk) & + !$omp depend(inout: a(iblk*bs+1, jblk*bs+1)) & + !$omp depend(in: perm(blk*bs+1)) depend(in: a(iblk*bs+1, blk*bs+1))& + !$omp depend(in: a(jblk*bs+1, blk*bs+1)) + IF (.NOT. aborted) THEN + CALL restore_if_req(iblk, jblk, blk, a, lda, bcopy, m, bs, n, & + cnelim, lperm) + CALL update_right(iblk, jblk, blk, a, lda, d, cdoff, cnelim, m, & + n, bs) + END IF + !$omp end task + END DO + END DO + END DO + !$omp end taskgroup + END SUBROUTINE run_pivoted + + INTEGER(ip_) FUNCTION blk_ncol(blk, n, bs) RESULT(r) + INTEGER(ip_), INTENT(IN) :: blk, n, bs + r = MIN(bs, n - blk*bs) + END FUNCTION blk_ncol + + INTEGER(ip_) FUNCTION blk_nrow(blk, m, bs) RESULT(r) + INTEGER(ip_), INTENT(IN) :: blk, m, bs + r = MIN(bs, m - blk*bs) + END FUNCTION blk_nrow + + SUBROUTINE permute_blkperm(perm, blk, bs, nc, lperm) + INTEGER(ip_), INTENT(INOUT) :: perm(*) + INTEGER(ip_), INTENT(IN) :: blk, bs, nc, lperm(*) + INTEGER(ip_) :: i, tmp(bs) + DO i = 1, nc + tmp(i) = perm(blk*bs + lperm(i) + 1) + END DO + DO i = 1, nc + perm(blk*bs + i) = tmp(i) + END DO + END SUBROUTINE permute_blkperm + +!------------------ backup / restore ------------------ + SUBROUTINE bkp_create(iblk, jblk, a, lda, bcopy, ldb, bs, m, n) + INTEGER(ip_), INTENT(IN) :: iblk, jblk, lda, ldb, bs, m, n + REAL(rp_), INTENT(IN) :: a(lda,*) + REAL(rp_), INTENT(INOUT) :: bcopy(ldb,*) + INTEGER(ip_) :: i, j, nr, nco + nr = blk_nrow(iblk, m, bs); nco = blk_ncol(jblk, n, bs) + DO j = 1, nco + DO i = 1, nr + bcopy(iblk*bs+i, jblk*bs+j) = a(iblk*bs+i, jblk*bs+j) + END DO + END DO + END SUBROUTINE bkp_create + + SUBROUTINE bkp_rperm(iblk, jblk, a, lda, bcopy, ldb, bs, n, lperm, nperm) + INTEGER(ip_), INTENT(IN) :: iblk, jblk, lda, ldb, bs, n, nperm + INTEGER(ip_), INTENT(IN) :: lperm(*) + REAL(rp_), INTENT(INOUT) :: a(lda,*), bcopy(ldb,*) + INTEGER(ip_) :: i, j, r, nr, nco + nr = blk_nrow(iblk, ldb, bs) ! ldb passed as m + nco = blk_ncol(jblk, n, bs) + DO j = 1, nco + DO i = 1, nperm + r = lperm(i) + 1 + bcopy(iblk*bs+i, jblk*bs+j) = a(iblk*bs+r, jblk*bs+j) + END DO + DO i = nperm+1, nr + bcopy(iblk*bs+i, jblk*bs+j) = a(iblk*bs+i, jblk*bs+j) + END DO + END DO + DO j = 1, nco + DO i = 1, nperm + a(iblk*bs+i, jblk*bs+j) = bcopy(iblk*bs+i, jblk*bs+j) + END DO + END DO + END SUBROUTINE bkp_rperm + + SUBROUTINE bkp_cperm(iblk, jblk, a, lda, bcopy, ldb, bs, n, lperm) + INTEGER(ip_), INTENT(IN) :: iblk, jblk, lda, ldb, bs, n + INTEGER(ip_), INTENT(IN) :: lperm(*) + REAL(rp_), INTENT(INOUT) :: a(lda,*), bcopy(ldb,*) + INTEGER(ip_) :: i, j, c, nr, nco + nr = blk_nrow(iblk, ldb, bs) + nco = blk_ncol(jblk, n, bs) + DO j = 1, nco + c = lperm(j) + 1 + DO i = 1, nr + bcopy(iblk*bs+i, jblk*bs+j) = a(iblk*bs+i, jblk*bs+c) + END DO + END DO + DO j = 1, nco + DO i = 1, nr + a(iblk*bs+i, jblk*bs+j) = bcopy(iblk*bs+i, jblk*bs+j) + END DO + END DO + END SUBROUTINE bkp_cperm + + SUBROUTINE bkp_restore_part(iblk, jblk, rfrom, cfrom, a, lda, bcopy, ldb, & + bs, n) + INTEGER(ip_), INTENT(IN) :: iblk, jblk, rfrom, cfrom, lda, ldb, bs, n + REAL(rp_), INTENT(INOUT) :: a(lda,*) + REAL(rp_), INTENT(IN) :: bcopy(ldb,*) + INTEGER(ip_) :: i, j, nr, nco + nr = blk_nrow(iblk, ldb, bs); nco = blk_ncol(jblk, n, bs) + DO j = cfrom, nco-1 + DO i = rfrom, nr-1 + a(iblk*bs+i+1, jblk*bs+j+1) = bcopy(iblk*bs+i+1, jblk*bs+j+1) + END DO + END DO + END SUBROUTINE bkp_restore_part + + SUBROUTINE bkp_restore_sym(iblk, jblk, from, a, lda, bcopy, ldb, bs, n, lperm) + INTEGER(ip_), INTENT(IN) :: iblk, jblk, from, lda, ldb, bs, n + INTEGER(ip_), INTENT(IN) :: lperm(*) + REAL(rp_), INTENT(INOUT) :: a(lda,*) + REAL(rp_), INTENT(IN) :: bcopy(ldb,*) + INTEGER(ip_) :: i, j, c, r, nr, nco + nr = blk_nrow(iblk, ldb, bs); nco = blk_ncol(jblk, n, bs) + DO j = from, nco-1 + c = lperm(j+1) + DO i = from, nco-1 + r = lperm(i+1) + IF (r > c) THEN + a(iblk*bs+i+1, jblk*bs+j+1) = bcopy(iblk*bs+r+1, jblk*bs+c+1) + ELSE + a(iblk*bs+i+1, jblk*bs+j+1) = bcopy(iblk*bs+c+1, jblk*bs+r+1) + END IF + END DO + DO i = nco, nr-1 + a(iblk*bs+i+1, jblk*bs+j+1) = bcopy(iblk*bs+i+1, jblk*bs+c+1) + END DO + END DO + END SUBROUTINE bkp_restore_sym + + SUBROUTINE restore_if_req(iblk, jblk, elim, a, lda, bcopy, ldb, bs, n, & + cnelim, lperm) + INTEGER(ip_), INTENT(IN) :: iblk, jblk, elim, lda, ldb, bs, n + INTEGER(ip_), INTENT(IN) :: cnelim(0:*), lperm(bs,0:*) + REAL(rp_), INTENT(INOUT) :: a(lda,*) + REAL(rp_), INTENT(IN) :: bcopy(ldb,*) + INTEGER(ip_) :: rfrom + IF (iblk == elim .AND. jblk == elim) THEN + IF (cnelim(iblk) < blk_ncol(iblk,n,bs)) & + CALL bkp_restore_sym(iblk, jblk, cnelim(iblk), a, lda, bcopy, ldb, bs, & + n, lperm(1,iblk)) + ELSE IF (iblk == elim) THEN + IF (cnelim(iblk) < blk_nrow(iblk,ldb,bs)) & + CALL bkp_restore_part(iblk, jblk, cnelim(iblk), cnelim(jblk), a, lda, & + bcopy, ldb, bs, n) + ELSE IF (jblk == elim) THEN + IF (cnelim(jblk) < blk_ncol(jblk,n,bs)) THEN + rfrom = 0 + IF (iblk <= elim) rfrom = cnelim(iblk) + CALL bkp_restore_part(iblk, jblk, rfrom, cnelim(jblk), a, lda, bcopy, & + ldb, bs, n) + END IF + END IF + END SUBROUTINE restore_if_req + +!------------------ apply_pivot_app (T / N) ------------------ + INTEGER(ip_) FUNCTION apply_T(blk, jblk, a, lda, d, cdoff, cnelim, m, n, bs, & + small, u) RESULT(res) + INTEGER(ip_), INTENT(IN) :: blk, jblk, lda, m, n, bs + INTEGER(ip_), INTENT(IN) :: cdoff(0:*), cnelim(0:*) + REAL(rp_), INTENT(INOUT) :: a(lda,*) + REAL(rp_), INTENT(IN) :: d(*), small, u + INTEGER(ip_) :: nc + nc = blk_ncol(jblk, n, bs) + ! ApplyT: diag = block(blk,blk), aval = block(blk,jblk) + CALL app_apply_pivot(.TRUE., cnelim(blk), nc, cnelim(jblk), & + a(blk*bs+1, blk*bs+1), lda, d(cdoff(blk)+1), small, & + a(blk*bs+1, jblk*bs+1), lda) + res = app_check_threshold(.TRUE., 0_ip_, cnelim(blk), cnelim(jblk), nc, u, & + a(blk*bs+1, jblk*bs+1), lda) + END FUNCTION apply_T + + INTEGER(ip_) FUNCTION apply_N(iblk, blk, a, lda, d, cdoff, cnelim, m, n, bs, & + small, u) RESULT(res) + INTEGER(ip_), INTENT(IN) :: iblk, blk, lda, m, n, bs + INTEGER(ip_), INTENT(IN) :: cdoff(0:*), cnelim(0:*) + REAL(rp_), INTENT(INOUT) :: a(lda,*) + REAL(rp_), INTENT(IN) :: d(*), small, u + INTEGER(ip_) :: nr + nr = blk_nrow(iblk, m, bs) + ! ApplyN: diag = block(blk,blk), aval = block(iblk,blk) + CALL app_apply_pivot(.FALSE., nr, cnelim(blk), 0_ip_, & + a(blk*bs+1, blk*bs+1), lda, d(cdoff(blk)+1), small, & + a(iblk*bs+1, blk*bs+1), lda) + res = app_check_threshold(.FALSE., 0_ip_, nr, 0_ip_, cnelim(blk), u, & + a(iblk*bs+1, blk*bs+1), lda) + END FUNCTION apply_N + +!------------------ update (right / left) ------------------ + SUBROUTINE update_right(iblk, jblk, blk, a, lda, d, cdoff, cnelim, m, n, bs) + INTEGER(ip_), INTENT(IN) :: iblk, jblk, blk, lda, m, n, bs + INTEGER(ip_), INTENT(IN) :: cdoff(0:*), cnelim(0:*) + REAL(rp_), INTENT(INOUT) :: a(lda,*) + REAL(rp_), INTENT(IN) :: d(*) + INTEGER(ip_) :: rfrom, cfrom, nr, nco, ke, ldld + REAL(rp_), ALLOCATABLE :: ld(:,:) + ke = cnelim(blk) + IF (ke == 0) RETURN + nr = blk_nrow(iblk, m, bs); nco = blk_ncol(jblk, n, bs) + rfrom = 0; IF (iblk <= blk) rfrom = cnelim(iblk) + cfrom = 0; IF (jblk <= blk) cfrom = cnelim(jblk) + IF (nr-rfrom <= 0 .OR. nco-cfrom <= 0) RETURN + ldld = nr + ALLOCATE(ld(MAX(nr,1), MAX(ke,1))) + ! isrc = (iblk,blk) rows [rfrom,nr); calcLD OP_N + CALL calc_ld(.FALSE., nr-rfrom, ke, a(iblk*bs+rfrom+1, blk*bs+1), lda, & + d(cdoff(blk)+1), ld(rfrom+1,1), ldld) + ! jsrc = (jblk,blk) rows [cfrom,nco) + CALL DGEMM('N', 'T', nr-rfrom, nco-cfrom, ke, -1.0_rp_, ld(rfrom+1,1), & + ldld, a(jblk*bs+cfrom+1, blk*bs+1), lda, 1.0_rp_, & + a(iblk*bs+rfrom+1, jblk*bs+cfrom+1), lda) + DEALLOCATE(ld) + END SUBROUTINE update_right + + SUBROUTINE update_left(iblk, jblk, blk, a, lda, d, cdoff, cnelim, m, n, bs) + INTEGER(ip_), INTENT(IN) :: iblk, jblk, blk, lda, m, n, bs + INTEGER(ip_), INTENT(IN) :: cdoff(0:*), cnelim(0:*) + REAL(rp_), INTENT(INOUT) :: a(lda,*) + REAL(rp_), INTENT(IN) :: d(*) + INTEGER(ip_) :: rfrom, cfrom, nr, nco, ke, ldld, isrc_r, isrc_c + REAL(rp_), ALLOCATABLE :: ld(:,:) + ke = cnelim(blk) + IF (ke == 0) RETURN + nr = blk_nrow(iblk, m, bs); nco = blk_ncol(jblk, n, bs) + rfrom = 0; IF (iblk <= blk) rfrom = cnelim(iblk) + cfrom = 0; IF (jblk <= blk) cfrom = cnelim(jblk) + IF (nr-rfrom <= 0 .OR. nco-cfrom <= 0) RETURN + ldld = nr + ALLOCATE(ld(MAX(nr,1), MAX(ke,1))) + IF (blk <= iblk) THEN + isrc_r = iblk; isrc_c = blk + ! isrc.j_ == elim_col -> calcLD OP_N, isrc.aval_[rfrom] (row offset) + CALL calc_ld(.FALSE., nr-rfrom, ke, a(isrc_r*bs+rfrom+1, isrc_c*bs+1), & + lda, d(cdoff(blk)+1), ld(rfrom+1,1), ldld) + ELSE + isrc_r = blk; isrc_c = iblk + ! isrc.j_ != elim_col -> calcLD OP_T, isrc.aval_[rfrom*lda] (col offset) + CALL calc_ld(.TRUE., nr-rfrom, ke, a(isrc_r*bs+1, isrc_c*bs+rfrom+1), & + lda, d(cdoff(blk)+1), ld(rfrom+1,1), ldld) + END IF + ! jsrc = (blk,jblk), col offset cfrom + CALL DGEMM('N', 'N', nr-rfrom, nco-cfrom, ke, -1.0_rp_, ld(rfrom+1,1), ldld, & + a(blk*bs+1, jblk*bs+cfrom+1), lda, 1.0_rp_, & + a(iblk*bs+rfrom+1, jblk*bs+cfrom+1), lda) + DEALLOCATE(ld) + END SUBROUTINE update_left + +!------------------ compaction: move_back / copy_failed / move_up ------ + SUBROUTINE move_back(nc, nelim, perm, elim_perm, failed_perm) + INTEGER(ip_), INTENT(IN) :: nc, nelim + INTEGER(ip_), INTENT(IN) :: perm(*) + INTEGER(ip_), INTENT(INOUT) :: elim_perm(*), failed_perm(*) + INTEGER(ip_) :: i + ! perm and elim_perm may overlap (elim_perm points earlier into same array) + DO i = 1, nelim + elim_perm(i) = perm(i) + END DO + DO i = nelim+1, nc + failed_perm(i-nelim) = perm(i) + END DO + END SUBROUTINE move_back + + SUBROUTINE copy_failed_diag(iblk, jblk, mib, njb, inelim, jnelim, a, lda, & + fdiag, ldc, num_elim, nfail, jins, ifl, iins, jf, bs) + INTEGER(ip_), INTENT(IN) :: iblk, jblk, mib, njb, inelim, jnelim, lda + INTEGER(ip_), INTENT(IN) :: ldc, num_elim, nfail, jins, ifl, iins, jf, bs + REAL(rp_), INTENT(IN) :: a(lda,*) + REAL(rp_), INTENT(INOUT) :: fdiag(ldc,*) + INTEGER(ip_) :: i, j, iout, jout, r0, c0 + r0 = iblk*bs; c0 = jblk*bs + ! rows: failed rows (i>=inelim), elim cols (j + ! rout @ (jins col, ifl row) + DO j = 0, jnelim-1 + iout = 0 + DO i = inelim, mib-1 + fdiag(ifl+iout+1, jins+j+1) = a(r0+i+1, c0+j+1) + iout = iout + 1 + END DO + END DO + ! cols^T (only if off-diagonal block): elim rows (i=jnelim) + IF (iblk /= jblk) THEN + jout = 0 + DO j = jnelim, njb-1 + DO i = 0, inelim-1 + fdiag(jf+jout+1, iins+i+1) = a(r0+i+1, c0+j+1) + END DO + jout = jout + 1 + END DO + END IF + ! failed x failed intersection -> dout @ (num_elim+jf col, ifl row) + jout = 0 + DO j = jnelim, njb-1 + iout = 0 + DO i = inelim, mib-1 + fdiag(ifl+iout+1, num_elim+jf+jout+1) = a(r0+i+1, c0+j+1) + iout = iout + 1 + END DO + jout = jout + 1 + END DO + END SUBROUTINE copy_failed_diag + + SUBROUTINE copy_failed_rect(jblk, jnelim, njb, a, lda, frect, ldr, jf, & + n, m, bs) + INTEGER(ip_), INTENT(IN) :: jblk, jnelim, njb, lda, ldr, jf, n, m, bs + REAL(rp_), INTENT(IN) :: a(lda,*) + REAL(rp_), INTENT(INOUT) :: frect(ldr,*) + INTEGER(ip_) :: j, i, jout, c0 + c0 = jblk*bs + jout = 0 + DO j = jnelim, njb-1 + DO i = 0, m-n-1 + frect(i+1, jf+jout+1) = a(n+i+1, c0+j+1) + END DO + jout = jout + 1 + END DO + END SUBROUTINE copy_failed_rect + + SUBROUTINE move_up_diag(iblk, jblk, inelim, jnelim, a, lda, iins, jins, bs) + INTEGER(ip_), INTENT(IN) :: iblk, jblk, inelim, jnelim, lda, iins, jins, bs + REAL(rp_), INTENT(INOUT) :: a(lda,*) + INTEGER(ip_) :: i, j, r0, c0 + r0 = iblk*bs; c0 = jblk*bs + IF (iins == r0 .AND. jins == c0) RETURN + DO j = 0, jnelim-1 + DO i = 0, inelim-1 + a(iins+i+1, jins+j+1) = a(r0+i+1, c0+j+1) + END DO + END DO + END SUBROUTINE move_up_diag + + SUBROUTINE move_up_rect_all(jblk, jnelim, a, lda, jins, n, m, bs) + INTEGER(ip_), INTENT(IN) :: jblk, jnelim, lda, jins, n, m, bs + REAL(rp_), INTENT(INOUT) :: a(lda,*) + INTEGER(ip_) :: i, j, c0 + c0 = jblk*bs + IF (jins == c0) RETURN + DO j = 0, jnelim-1 + DO i = n, m-1 + a(i+1, jins+j+1) = a(i+1, c0+j+1) + END DO + END DO + END SUBROUTINE move_up_rect_all + +!====================== unpivoted (aggressive) path ==================== + ! Apply the diagonal block's row permutation lperm to the first ncol(iblk) + ! rows of block (iblk,jblk), no backup (used in the optimistic unpivoted pass) + SUBROUTINE apply_rperm(iblk, jblk, a, lda, bs, m, n, lperm) + INTEGER(ip_), INTENT(IN) :: iblk, jblk, lda, bs, m, n, lperm(*) + REAL(rp_), INTENT(INOUT) :: a(lda,*) + INTEGER(ip_) :: j, i, r, nco, np + REAL(rp_), ALLOCATABLE :: lw(:,:) + nco = blk_ncol(jblk, n, bs); np = blk_ncol(iblk, n, bs) + ALLOCATE(lw(MAX(np,1), MAX(nco,1))) + DO j = 1, nco + DO i = 1, np + r = lperm(i) + 1 + lw(i, j) = a(iblk*bs+r, jblk*bs+j) + END DO + END DO + DO j = 1, nco + DO i = 1, np + a(iblk*bs+i, jblk*bs+j) = lw(i, j) + END DO + END DO + DEALLOCATE(lw) + END SUBROUTINE apply_rperm + + ! Apply the diagonal block's column permutation lperm to block (iblk,jblk). + SUBROUTINE apply_cperm(iblk, jblk, a, lda, bs, m, n, lperm) + INTEGER(ip_), INTENT(IN) :: iblk, jblk, lda, bs, m, n, lperm(*) + REAL(rp_), INTENT(INOUT) :: a(lda,*) + INTEGER(ip_) :: j, i, c, nco, nr + REAL(rp_), ALLOCATABLE :: lw(:,:) + nco = blk_ncol(jblk, n, bs); nr = blk_nrow(iblk, m, bs) + ALLOCATE(lw(MAX(nr,1), MAX(nco,1))) + DO j = 1, nco + c = lperm(j) + 1 + DO i = 1, nr + lw(i, j) = a(iblk*bs+i, jblk*bs+c) + END DO + END DO + DO j = 1, nco + DO i = 1, nr + a(iblk*bs+i, jblk*bs+j) = lw(i, j) + END DO + END DO + DEALLOCATE(lw) + END SUBROUTINE apply_cperm + + ! Inverse of apply_rperm (undo a failed row permutation on recovery). + SUBROUTINE apply_inv_rperm(iblk, jblk, a, lda, bs, m, n, lperm) + INTEGER(ip_), INTENT(IN) :: iblk, jblk, lda, bs, m, n, lperm(*) + REAL(rp_), INTENT(INOUT) :: a(lda,*) + INTEGER(ip_) :: j, i, r, nco, np + REAL(rp_), ALLOCATABLE :: lw(:,:) + nco = blk_ncol(jblk, n, bs); np = blk_ncol(iblk, n, bs) + ALLOCATE(lw(MAX(np,1), MAX(nco,1))) + DO j = 1, nco + DO i = 1, np + r = lperm(i) + 1 + lw(r, j) = a(iblk*bs+i, jblk*bs+j) + END DO + END DO + DO j = 1, nco + DO i = 1, np + a(iblk*bs+i, jblk*bs+j) = lw(i, j) + END DO + END DO + DEALLOCATE(lw) + END SUBROUTINE apply_inv_rperm + + ! Number of columns in the accepted leading prefix of fully-passed block cols. + INTEGER(ip_) FUNCTION calc_nelim_up(m, bs, mblk, nblk, cnpass, cnelim) & + RESULT(res) + INTEGER(ip_), INTENT(IN) :: m, bs, mblk, nblk, cnpass(0:*), cnelim(0:*) + INTEGER(ip_) :: j + res = 0 + DO j = 0, nblk-1 + IF (cnpass(j) == mblk - j) THEN + res = res + cnelim(j) + ELSE + EXIT + END IF + END DO + END FUNCTION calc_nelim_up + + ! Optimistic unpivoted factorization (port of run_elim_unpivoted_notasks): + ! assume every pivot passes; abort at the first block column that does not + ! fully eliminate or whose below-block fails the a-posteriori test. Records + ! per-block progress in up2d for restore(). Serial. A full backup of a into + ! bcopy must be taken by the caller beforehand. + RECURSIVE SUBROUTINE run_unpivoted(m, n, perm, a, lda, d, u, small, action, & + bs, inner, aggr, mblk, nblk, cnelim, cnpass, cfirst, cdoff, lperm, & + up2d, lut, num_elim, flag) + INTEGER(ip_), INTENT(IN) :: m, n, lda, bs, inner, mblk, nblk + INTEGER(ip_), INTENT(INOUT) :: perm(*) + REAL(rp_), INTENT(INOUT) :: a(lda,*), d(*) + REAL(rp_), INTENT(IN) :: u, small + LOGICAL, INTENT(IN) :: action, aggr, lut + INTEGER(ip_), INTENT(INOUT) :: cnelim(0:*), cnpass(0:*), cdoff(0:*) + LOGICAL, INTENT(INOUT) :: cfirst(0:*) + INTEGER(ip_), INTENT(INOUT) :: lperm(bs, 0:*), up2d(0:mblk-1, 0:nblk-1) + INTEGER(ip_), INTENT(OUT) :: num_elim, flag + INTEGER(ip_) :: blk, jblk, iblk, next_elim, i + INTEGER(ip_) :: tnc, tnr, tdoff, tnelim, tbp, tlflag + LOGICAL :: aborted, la + REAL(rp_) :: adum(1,1) + REAL(rp_), ALLOCATABLE :: tldw(:,:) + ! Task-parallel optimistic unpivoted pass (port of run_elim_unpivoted). The + ! full backup lives in bcopy (taken by the caller), so tasks never back up. + ! Dependencies are purely on the a-blocks (no adjust / no perm token); each + ! task records its progress in up2d and bails out if another task has + ! already signalled abort. With lut=.false. (or no OpenMP) every task is + ! undeferred and this runs in the exact serial order of + ! run_elim_unpivoted_notasks. + flag = 0; next_elim = 0; aborted = .FALSE. + !$omp taskgroup + DO blk = 0, nblk-1 + ! --- factor diagonal block --- + !$omp task if(lut) default(shared) firstprivate(blk) & + !$omp private(tnc, tnr, tdoff, tnelim, tldw, tlflag, i, la) & + !$omp depend(inout: a(blk*bs+1, blk*bs+1)) + !$omp atomic read + la = aborted + IF (.NOT. la) THEN + tnc = blk_ncol(blk, n, bs); tnr = blk_nrow(blk, m, bs) + tdoff = 2*next_elim; cdoff(blk) = tdoff + DO i = 1, tnc + lperm(i, blk) = i-1 + END DO + up2d(blk, blk) = blk + tlflag = 0 + IF (bs > inner) THEN + tnelim = ldlt_app_factor(tnr, tnc, lperm(1,blk), & + a(blk*bs+1,blk*bs+1), lda, d(tdoff+1), u, small, & + action, inner, tlflag, .FALSE., aggr) + IF (tlflag == 0) CALL permute_blkperm(perm, blk, bs, tnc,lperm(1,blk)) + ELSE IF (tnc < bs) THEN + ALLOCATE(tldw(tnr+2, 2)) + tnelim = ldlt_tpp_factor(tnr, tnc,lperm(1,blk), a(blk*bs+1,blk*bs+1),& + lda, d(tdoff+1), tldw, tnr+2, action, u, small, 0_ip_, & + adum, 1_ip_, tlflag) + DEALLOCATE(tldw) + IF (tlflag == 0) CALL permute_blkperm(perm, blk, bs,tnc, lperm(1,blk)) + ELSE + ALLOCATE(tldw(bs, bs)) + CALL block_ldlt(0_ip_, perm(blk*bs+1), a(blk*bs+1,blk*bs+1), lda, & + d(tdoff+1), tldw, action, u, small, lperm(1,blk), & + bs, tlflag) + DEALLOCATE(tldw); tnelim = bs + END IF + IF (tlflag /= 0) THEN + ! keep OOM(2) vs abort(1) + flag = MERGE(FLAG_OOM, FLAG_SINGULAR, tlflag == FLAG_OOM) + !$omp atomic write + aborted = .TRUE. + ELSE + cnelim(blk) = tnelim + IF (tnelim < tnc) THEN + cnpass(blk) = 0 ! diagonal not fully eliminated + !$omp atomic write + aborted = .TRUE. + ELSE + cfirst(blk) = (blk == 0) + cnpass(blk) = 1 ! init_passed(1): diagonal passed + next_elim = next_elim + tnelim + END IF + END IF + END IF + !$omp end task + ! --- apply row perm to eliminated ROW blocks (jblkblk), test threshold -- + DO iblk = blk+1, mblk-1 + !$omp task if(lut) default(shared) firstprivate(blk, iblk) & + !$omp private(tbp, la) depend(in: a(blk*bs+1, blk*bs+1)) & + !$omp depend(inout: a(iblk*bs+1, blk*bs+1)) + !$omp atomic read + la = aborted + IF (.NOT. la) THEN + up2d(iblk, blk) = blk + CALL apply_cperm(iblk, blk, a, lda, bs, m, n, lperm(1,blk)) + tbp = apply_N(iblk, blk, a, lda, d, cdoff, cnelim, m, n, bs, small, u) + IF (tbp < cnelim(blk)) THEN ! test_fail -> column not fully passed + !$omp atomic write + aborted = .TRUE. + ELSE + !$omp atomic update + cnpass(blk) = cnpass(blk) + 1 + END IF + END IF + !$omp end task + END DO + ! --- update trailing columns [blk+1, nblk) (optimistic, no restore) --- + DO jblk = blk+1, nblk-1 + DO iblk = jblk, mblk-1 + !$omp task if(lut) default(shared) firstprivate(blk, jblk, iblk) & + !$omp private(la) depend(inout: a(iblk*bs+1, jblk*bs+1)) & + !$omp depend(in: a(iblk*bs+1, blk*bs+1)) & + !$omp depend(in: a(jblk*bs+1, blk*bs+1)) + !$omp atomic read + la = aborted + IF (.NOT. la) THEN + up2d(iblk, jblk) = blk + CALL update_right(iblk, jblk, blk, a, lda, d, cdoff, cnelim, & + m, n, bs) + END IF + !$omp end task + END DO + END DO + END DO + !$omp end taskgroup + IF (flag /= 0) THEN + num_elim = -1 + ELSE + num_elim = calc_nelim_up(m, bs, mblk, nblk, cnpass, cnelim) + END IF + END SUBROUTINE run_unpivoted + + ! Roll back the matrix after a failed optimistic pass to a state consistent + ! with nelim_blk accepted block columns, ready for the careful pivoted pass to + ! resume from block nelim_blk (port of restore(), serial). + SUBROUTINE restore_unpiv(nelim_blk, m, n, perm, a, lda, d, bs, mblk, nblk, & + cnelim, cdoff, lperm, bcopy, up2d, old_perm) + INTEGER(ip_), INTENT(IN) :: nelim_blk, m, n, lda, bs, mblk, nblk + INTEGER(ip_), INTENT(INOUT) :: perm(*) + REAL(rp_), INTENT(INOUT) :: a(lda,*) + REAL(rp_), INTENT(IN) :: d(*), bcopy(m,*) + INTEGER(ip_), INTENT(IN) :: cnelim(0:*), cdoff(0:*), lperm(bs,0:*) + INTEGER(ip_), INTENT(IN) :: up2d(0:mblk-1, 0:nblk-1), old_perm(*) + INTEGER(ip_) :: i, jblk, iblk, kblk, progress + ! 1. restore permutation of the failed part + DO i = nelim_blk*bs, n-1 + perm(i+1) = old_perm(i+1) + END DO + ! 2. undo failed row perms in accepted columns + DO jblk = 0, nelim_blk-1 + DO iblk = nelim_blk, nblk-1 + IF (up2d(iblk, jblk) >= nelim_blk) & + CALL apply_inv_rperm(iblk, jblk, a, lda, bs, m, n, lperm(1,iblk)) + END DO + END DO + ! 3. failed columns: full reset of over-updated blocks + apply missing + ! updates + DO jblk = nelim_blk, nblk-1 + DO iblk = jblk, mblk-1 + progress = up2d(iblk, jblk) + IF (progress >= nelim_blk) THEN + CALL bkp_restore_part(iblk, jblk, 0_ip_, 0_ip_, a, lda, bcopy, m, & + bs, n) + progress = -1 + END IF + DO kblk = progress+1, nelim_blk-1 + CALL update_right(iblk, jblk, kblk, a, lda, d, cdoff, cnelim, m, & + n, bs) + END DO + END DO + END DO + END SUBROUTINE restore_unpiv + + +! ========================= factor_node_indef ========================== + SUBROUTINE factor_node_indef(nrow, ncol, ndelay_in, a, lda, d, perm, & + contrib, ldcontrib, action, u, small, nb, posdef, nelim, ndelay_out, & + failed_tpp, nfirst, nsecond, alloc_err) + INTEGER(ip_), INTENT(IN) :: nrow, ncol, ndelay_in, lda, ldcontrib, nb + REAL(rp_), INTENT(INOUT) :: a(lda, *), d(*) + INTEGER(ip_), INTENT(INOUT) :: perm(*) + REAL(rp_), INTENT(INOUT) :: contrib(ldcontrib, *) + LOGICAL, INTENT(IN) :: action, posdef + REAL(rp_), INTENT(IN) :: u, small + INTEGER(ip_), INTENT(OUT) :: nelim, ndelay_out + LOGICAL, INTENT(IN), OPTIONAL :: failed_tpp + ! columns not eliminated by the 1st (APP)/2nd (TPP finish) pass, for stats + INTEGER(ip_), INTENT(OUT), OPTIONAL :: nfirst, nsecond + LOGICAL, INTENT(OUT), OPTIONAL :: alloc_err ! .true. on OOM + INTEGER(ip_) :: m, n, flag, nbe, nelim2, ldld, nelim_app, st + LOGICAL :: ftpp, lfin + REAL(rp_), ALLOCATABLE :: ldblk(:, :), ldw(:, :) + m = nrow + ndelay_in + n = ncol + ndelay_in + IF (PRESENT(nfirst)) nfirst = 0 + IF (PRESENT(nsecond)) nsecond = 0 + IF (PRESENT(alloc_err)) alloc_err = .FALSE. + IF (posdef) THEN + ! Cholesky path (no pivoting, no delays); ndelay_in is always 0 here + CALL chol_factor_node(m, n, a, lda, d, contrib, ldcontrib, flag) + IF (flag == -2) THEN ! out of memory in the Cholesky contrib + IF (PRESENT(alloc_err)) alloc_err = .TRUE. + nelim = -1 + ELSE IF (flag < 0) THEN + nelim = -1 ! not positive definite (DPOTRF failed) + ELSE + nelim = n + END IF + ndelay_out = 0 + RETURN + END IF + ! failed_pivot_method: TPP (default) retries failed columns with ldlt_tpp + ftpp = .TRUE.; IF (PRESENT(failed_tpp)) ftpp = failed_tpp + nbe = nb + IF (nbe == 0) THEN + ! TPP method (sentinel nb=0): single unblocked ldlt_tpp panel + nelim = ldlt_blocked_factor(m, n, perm, a, lda, d, u, small, action, & + n, flag) + ELSE IF (nbe > 0) THEN + ! APP_BLOCK: a-posteriori pivoted, outer block nbe (= block_size), + ! inner block 32 via recursion, wide BLAS-3 updates. + nelim = ldlt_app_factor(m, n, perm, a, lda, d, u, small, action, nbe, & + flag) + ELSE + ! APP_AGGRESSIVE (nb<0): optimistic unpivoted-first at |nb|, falling + ! back to the pivoted pass on any a-posteriori failure. + nelim = ldlt_app_factor(m, n, perm, a, lda, d, u, small, action, & + -nbe, flag, aggressive = .TRUE.) + END IF + IF (flag == FLAG_OOM) THEN ! out of memory inside ldlt_app_factor + IF (PRESENT(alloc_err)) alloc_err = .TRUE. + nelim = -1; ndelay_out = 0; RETURN + END IF + IF (nelim < 0 .OR. flag < 0) THEN ! singular pivot, action=.FALSE., abort + ! caller maps nelim<0 to ERROR_SINGULAR + nelim = -1; ndelay_out = 0; RETURN + END IF + ! Finish off any APP-failed columns with TPP (port of the + ! failed_pivot_method branch in cpu/factor.hxx): always at a root + ! (m==n, no parent to delay to), and at every node when + ! failed_pivot_method = TPP (the default). This reduces the number + ! of delayed pivots and avoids spurious singularity. + nelim_app = nelim ! nelim after the first (APP) pass + lfin = .FALSE. + IF (nbe /= 0 .AND. nelim < n .AND. (m == n .OR. ftpp)) THEN + ldld = m - nelim + 2 + ALLOCATE(ldw(ldld, 2), stat=st) + IF (st /= 0) THEN + IF (PRESENT(alloc_err)) alloc_err = .TRUE. + nelim = -1; ndelay_out = 0; RETURN + END IF + nelim2 = ldlt_tpp_factor(m-nelim, n-nelim, perm(nelim+1), & + a(nelim+1, nelim+1), lda, d(2*nelim+1), ldw, ldld, & + action, u, small, nelim, a(nelim+1, 1), lda, flag) + DEALLOCATE(ldw) + IF (flag < 0) THEN ! singular during TPP finish, action=.FALSE. + nelim = -1; ndelay_out = 0; RETURN + END IF + nelim = nelim + nelim2 + lfin = .TRUE. + END IF + ! not_first_pass / not_second_pass (as in cpu/factor.hxx): for TPP the tpp + ! IS the first pass; for APP the first pass is the a-posteriori one and + ! the (optional) TPP finish is the second. + IF (PRESENT(nfirst)) THEN + IF (nbe == 0) THEN + nfirst = n - nelim + ELSE + nfirst = n - nelim_app + END IF + END IF + IF (PRESENT(nsecond)) THEN + IF (nbe /= 0 .AND. lfin) nsecond = n - nelim + END IF + IF (m-n > 0 .AND. nelim > 0) THEN + ALLOCATE(ldblk(m-n, nelim), stat=st) + IF (st /= 0) THEN + IF (PRESENT(alloc_err)) alloc_err = .TRUE. + nelim = -1; ndelay_out = 0; RETURN + END IF + CALL calc_ld(.FALSE., m-n, nelim, a(n+1, 1), lda, d, ldblk, m-n) + CALL DGEMM('N', 'T', m-n, m-n, nelim, -1.0_rp_, a(n+1, 1), lda, & + ldblk, m-n, 0.0_rp_, contrib, ldcontrib) + DEALLOCATE(ldblk) + END IF + ndelay_out = n - nelim + END SUBROUTINE factor_node_indef + + !> Cholesky (LL^T) node factor for positive-definite fronts, stored in the + !! same unit-L + D^-1 layout as the indef path (L_chol column j divided by + !! its diagonal, D_j = diag_j^2) so the assembly, solves and enquire are + !! reused unchanged. No pivoting / no delays. flag<0 if the block is not SPD + SUBROUTINE chol_factor_node(m, n, a, lda, d, contrib, ldcontrib, flag) + INTEGER(ip_), INTENT(IN) :: m, n, lda, ldcontrib + REAL(rp_), INTENT(INOUT) :: a(lda, *), d(*) + REAL(rp_), INTENT(INOUT) :: contrib(ldcontrib, *) + INTEGER(ip_), INTENT(OUT) :: flag + INTEGER(ip_) :: j, i, info, m2 + REAL(rp_) :: dj + REAL(rp_), ALLOCATABLE :: ldblk(:, :) + flag = 0 + CALL DPOTRF('L', n, a, lda, info) + IF (info /= 0) THEN; flag = FLAG_SINGULAR; RETURN; END IF + m2 = m - n + IF (m2 > 0) & + CALL DTRSM('R', 'L', 'T', 'N', m2, n, 1.0_rp_, a, lda, a(n+1,1), lda) + DO j = 1, n + dj = a(j, j) + d(2*j-1) = 1.0_rp_/(dj*dj); d(2*j) = 0.0_rp_ + DO i = j, m + a(i, j) = a(i, j)/dj + END DO + END DO + IF (m2 > 0) THEN + ALLOCATE(ldblk(m2, n), stat=info) + IF (info /= 0) THEN; flag = FLAG_OOM; RETURN; END IF ! out of memory + CALL calc_ld(.FALSE., m2, n, a(n+1, 1), lda, d, ldblk, m2) + CALL DGEMM('N', 'T', m2, m2, n, -1.0_rp_, a(n+1, 1), lda, ldblk, m2, & + 0.0_rp_, contrib, ldcontrib) + DEALLOCATE(ldblk) + END IF + END SUBROUTINE chol_factor_node + +! ============================ assemble ================================ + SUBROUTINE assemble_expected(from, to, cm, cache, contrib, ldc, & + lcol, ldl, parent_ncol) + INTEGER(ip_), INTENT(IN) :: from, to, cm, ldc, ldl, parent_ncol + INTEGER(ip_), INTENT(IN) :: cache(*) + REAL(rp_), INTENT(IN) :: contrib(ldc, *) + REAL(rp_), INTENT(INOUT) :: lcol(ldl, *) + INTEGER(ip_) :: i, j, c + DO i = from, to + c = cache(i) + IF (c <= parent_ncol) THEN + DO j = i, cm + lcol(cache(j), c) = lcol(cache(j), c) + contrib(j, i) + END DO + END IF + END DO + END SUBROUTINE assemble_expected + + SUBROUTINE assemble_expected_contrib(from, to, cm, cache, contrib, ldc, & + pcontrib, ldp) + INTEGER(ip_), INTENT(IN) :: from, to, cm, ldc, ldp + INTEGER(ip_), INTENT(IN) :: cache(*) + REAL(rp_), INTENT(IN) :: contrib(ldc, *) + REAL(rp_), INTENT(INOUT) :: pcontrib(ldp, *) + INTEGER(ip_) :: i, j, c + DO i = from, to + c = cache(i) + IF (c >= 1) THEN + DO j = i, cm + IF (cache(j) >= 1) & + pcontrib(cache(j), c) = pcontrib(cache(j), c) + contrib(j, i) + END DO + END IF + END DO + END SUBROUTINE assemble_expected_contrib + +! ========================= ldlt_app solves ============================ + SUBROUTINE ldlt_app_solve_fwd(m, n, l, ldl, nrhs, x, ldx) + INTEGER(ip_), INTENT(IN) :: m, n, ldl, nrhs, ldx + REAL(rp_), INTENT(IN) :: l(ldl, *) + REAL(rp_), INTENT(INOUT) :: x(ldx, *) + IF (n <= 0) RETURN + IF (nrhs == 1) THEN + CALL DTRSV('L', 'N', 'U', n, l(1,1), ldl, x(1,1), 1_ip_) + IF (m > n) & + CALL DGEMV('N', m-n, n, -1.0_rp_, l(n+1,1), ldl, x(1,1), 1_ip_, & + 1.0_rp_, x(n+1,1), 1_ip_) + ELSE + CALL DTRSM('L', 'L', 'N', 'U', n, nrhs, 1.0_rp_, l(1,1), ldl, x(1,1), & + ldx) + IF (m > n) & + CALL DGEMM('N', 'N', m-n, nrhs, n, -1.0_rp_, l(n+1,1), ldl, & + x(1,1), ldx, 1.0_rp_, x(n+1,1), ldx) + END IF + END SUBROUTINE ldlt_app_solve_fwd + + SUBROUTINE ldlt_app_solve_diag(n, d, nrhs, x, ldx) + INTEGER(ip_), INTENT(IN) :: n, nrhs, ldx + REAL(rp_), INTENT(IN) :: d(*) + REAL(rp_), INTENT(INOUT) :: x(ldx, *) + INTEGER(ip_) :: i, r + REAL(rp_) :: d11, d21, d22, x1, x2 + LOGICAL :: is_1x1 + i = 0 + DO WHILE (i < n) +! IF (i+1 == n .OR. IEEE_IS_FINITE(d(2*i+3))) THEN ! replace this by ... + is_1x1 = i + 1 == n + IF ( .NOT. is_1x1 ) is_1x1 = IEEE_IS_FINITE(d(2*i+3)) + IF ( is_1x1 ) THEN + d11 = d(2*i+1) + DO r = 1, nrhs + x(i+1, r) = x(i+1, r)*d11 + END DO + i = i + 1 + ELSE + d11 = d(2*i+1); d21 = d(2*i+2); d22 = d(2*i+4) + DO r = 1, nrhs + x1 = x(i+1, r); x2 = x(i+2, r) + x(i+1, r) = d11*x1 + d21*x2 + x(i+2, r) = d21*x1 + d22*x2 + END DO + i = i + 2 + END IF + END DO + END SUBROUTINE ldlt_app_solve_diag + + SUBROUTINE ldlt_app_solve_bwd(m, n, l, ldl, nrhs, x, ldx) + INTEGER(ip_), INTENT(IN) :: m, n, ldl, nrhs, ldx + REAL(rp_), INTENT(IN) :: l(ldl, *) + REAL(rp_), INTENT(INOUT) :: x(ldx, *) + IF (n <= 0) RETURN + IF (nrhs == 1) THEN + IF (m > n) & + CALL DGEMV('T', m-n, n, -1.0_rp_, l(n+1,1), ldl, x(n+1,1), 1_ip_, & + 1.0_rp_, x(1,1), 1_ip_) + CALL DTRSV('L', 'T', 'U', n, l(1,1), ldl, x(1,1), 1_ip_) + ELSE + IF (m > n) & + CALL DGEMM('T', 'N', n, nrhs, m-n, -1.0_rp_, l(n+1,1), ldl, & + x(n+1,1), ldx, 1.0_rp_, x(1,1), ldx) + CALL DTRSM('L', 'L', 'T', 'U', n, nrhs, 1.0_rp_, l(1,1), ldl, x(1,1), & + ldx) + END IF + END SUBROUTINE ldlt_app_solve_bwd + +! ===================== multifrontal driver (delays) =================== + !> Factor one node: assemble children (+ foreign contribs), factor, form the + !! Schur contribution. Uses a per-thread scratch pmap so it is + !! safe to call concurrently on independent nodes. node_ok is .false. only if + !! a root fails to eliminate all its columns. + SUBROUTINE factor_one_node(node, p, nnodes, n, action, u, small, nb, posdef,& + node_ok, contribs, failed_tpp, node_aok) + TYPE(dmf_node), INTENT(INOUT) :: node(:) + INTEGER(ip_), INTENT(IN) :: p, nnodes, n, nb + LOGICAL, INTENT(IN) :: action, posdef + REAL(rp_), INTENT(IN) :: u, small + LOGICAL, INTENT(OUT) :: node_ok + TYPE(subtree_contrib_t), INTENT(IN), OPTIONAL :: contribs(:) + LOGICAL, INTENT(IN), OPTIONAL :: failed_tpp + LOGICAL, INTENT(OUT), OPTIONAL :: node_aok ! .false. on OOM + LOGICAL :: ftpp, aerr + INTEGER(ip_) :: c, i, j, s, k, cm, ncc, pcol, ccol, crow, pr, g + INTEGER(ip_) :: dcol, ndout, ci, st + INTEGER(ip_), ALLOCATABLE :: cache(:) + REAL(rp_) :: contrib_dummy(1,1), val + node_ok = .TRUE. + IF (PRESENT(node_aok)) node_aok = .TRUE. + ftpp = .TRUE.; IF (PRESENT(failed_tpp)) ftpp = failed_tpp + IF (.NOT. ALLOCATED(tls_pmap)) THEN + ALLOCATE(tls_pmap(n)) + ELSE IF (SIZE(tls_pmap) < n) THEN + DEALLOCATE(tls_pmap); ALLOCATE(tls_pmap(n)) + END IF + ASSOCIATE (nd => node(p)) + nd%ndelay_in = 0 + DO c = 1, nnodes + IF (node(c)%parent == p) & + nd%ndelay_in = nd%ndelay_in + node(c)%ndelay_out + END DO + IF (PRESENT(contribs) .AND. ALLOCATED(nd%contribs)) THEN + DO k = 1, SIZE(nd%contribs) + nd%ndelay_in = nd%ndelay_in + contribs(nd%contribs(k))%ndelay + END DO + END IF + nd%ncol = nd%symb_ncol + nd%ndelay_in + nd%nrow = nd%symb_nrow + nd%ndelay_in + nd%ldl = nd%nrow + cm = nd%symb_nrow - nd%symb_ncol + ! guard the size-proportional (per-front) allocations against OOM + IF (ALLOCATED(nd%lcol)) DEALLOCATE(nd%lcol) + ALLOCATE(nd%lcol(nd%ldl, nd%ncol), stat=st) + IF (st == 0) THEN + IF (ALLOCATED(nd%perm)) DEALLOCATE(nd%perm) + ALLOCATE(nd%perm(nd%ncol), stat=st) + END IF + IF (st == 0) THEN + IF (ALLOCATED(nd%d)) DEALLOCATE(nd%d) + ALLOCATE(nd%d(2*nd%ncol+2), stat=st) + END IF + IF (st == 0 .AND. cm > 0) THEN + IF (ALLOCATED(nd%contrib)) DEALLOCATE(nd%contrib) + ALLOCATE(nd%contrib(cm,cm), stat=st) + END IF + IF (st /= 0) THEN ! out of memory forming this front + node_ok = .FALSE. + IF (PRESENT(node_aok)) node_aok = .FALSE. + RETURN + END IF + nd%lcol = 0._rp_ + IF (cm > 0) nd%contrib = 0._rp_ + DO i = 1, nd%symb_ncol + nd%perm(i) = nd%rlist(i); tls_pmap(nd%rlist(i)) = i + END DO + DO i = nd%symb_ncol+1, nd%symb_nrow + tls_pmap(nd%rlist(i)) = i + nd%ndelay_in + END DO + IF (ALLOCATED(nd%av)) THEN + DO k = 1, SIZE(nd%av) + i = nd%ai(k); IF (i > nd%symb_ncol) i = i + nd%ndelay_in + nd%lcol(i, nd%aj(k)) = nd%lcol(i, nd%aj(k)) + nd%av(k) + END DO + END IF + dcol = nd%symb_ncol + DO c = 1, nnodes + IF (node(c)%parent /= p) CYCLE + ASSOCIATE (ch => node(c)) + DO i = 0, ch%ndelay_out-1 + pcol = dcol + 1; ccol = ch%nelim + i + 1 + nd%perm(pcol) = ch%perm(ccol) + DO j = 0, ch%ndelay_out-1-i + nd%lcol(pcol+j, pcol) = ch%lcol(ccol+j, ccol) + END DO + DO s = ch%symb_ncol+1, ch%symb_nrow + g = ch%rlist(s); crow = s + ch%ndelay_in + val = ch%lcol(crow, ccol); pr = tls_pmap(g) + IF (pr <= nd%ncol) THEN + nd%lcol(pcol, pr) = nd%lcol(pcol, pr) + val + ELSE + nd%lcol(pr, pcol) = nd%lcol(pr, pcol) + val + END IF + END DO + dcol = dcol + 1 + END DO + IF (ch%symb_nrow - ch%symb_ncol > 0) THEN + CALL build_cache(ch, tls_pmap, cache) + CALL assemble_expected(1_ip_, ch%symb_nrow-ch%symb_ncol, & + ch%symb_nrow-ch%symb_ncol, cache, ch%contrib, & + ch%symb_nrow-ch%symb_ncol, nd%lcol, nd%ldl, nd%ncol) + END IF + END ASSOCIATE + END DO + IF (PRESENT(contribs) .AND. ALLOCATED(nd%contribs)) THEN + DO ci = 1, SIZE(nd%contribs) + ASSOCIATE (ct => contribs(nd%contribs(ci))) + DO i = 1, ct%ndelay + pcol = dcol + 1 + nd%perm(pcol) = ct%delay_perm(i) + DO j = i, ct%ndelay + nd%lcol(pcol + (j-i), pcol) = ct%delay_val(j, i) + END DO + DO k = 1, ct%cn + pr = tls_pmap(ct%rlist(k)) + val = ct%delay_val(ct%ndelay + k, i) + IF (pr <= nd%ncol) THEN + nd%lcol(pcol, pr) = nd%lcol(pcol, pr) + val + ELSE + nd%lcol(pr, pcol) = nd%lcol(pr, pcol) + val + END IF + END DO + dcol = dcol + 1 + END DO + IF (ct%cn > 0) THEN + IF (ALLOCATED(cache)) DEALLOCATE(cache) + ALLOCATE(cache(ct%cn)) + DO k = 1, ct%cn + cache(k) = tls_pmap(ct%rlist(k)) + END DO + CALL assemble_expected(1_ip_, ct%cn, ct%cn, cache, ct%val, & + ct%cn, nd%lcol, nd%ldl, nd%ncol) + END IF + END ASSOCIATE + END DO + END IF + ncc = cm + aerr = .FALSE. + IF (ncc > 0) THEN + CALL factor_node_indef(nd%symb_nrow, nd%symb_ncol, nd%ndelay_in, & + nd%lcol, nd%ldl, nd%d, nd%perm, nd%contrib, ncc, action, u, & + small, nb, posdef, nd%nelim, ndout, failed_tpp = ftpp, & + nfirst = nd%nfirst, nsecond = nd%nsecond, alloc_err = aerr) + ELSE + CALL factor_node_indef(nd%symb_nrow, nd%symb_ncol, nd%ndelay_in, & + nd%lcol, nd%ldl, nd%d, nd%perm, contrib_dummy, 1_ip_, action, & + u, small, nb, posdef, nd%nelim, ndout, failed_tpp = ftpp, & + nfirst = nd%nfirst, nsecond = nd%nsecond, alloc_err = aerr) + END IF + IF (aerr) THEN ! out of memory during this node's factor + node_ok = .FALSE. + IF (PRESENT(node_aok)) node_aok = .FALSE. + RETURN + END IF + IF (nd%nelim < 0) THEN ! non-SPD (posdef) or singular (indef, action=F) + node_ok = .FALSE. ! -> ERROR_NOT_POS_DEF (posdef) / ERROR_SINGULAR + nd%nelim = nd%ncol ! keep downstream indexing sane + END IF + nd%ndelay_out = nd%ncol - nd%nelim + IF (nd%parent == 0 .AND. nd%ndelay_out /= 0) node_ok = .FALSE. + IF (ncc > 0) THEN + DO c = 1, nnodes + IF (node(c)%parent /= p) CYCLE + ASSOCIATE (ch => node(c)) + IF (ch%symb_nrow - ch%symb_ncol > 0) THEN + CALL build_cache(ch, tls_pmap, cache) + DO k = 1, ch%symb_nrow-ch%symb_ncol + cache(k) = cache(k) - nd%ncol + END DO + CALL assemble_expected_contrib(1_ip_, & + ch%symb_nrow-ch%symb_ncol, & + ch%symb_nrow-ch%symb_ncol, cache, ch%contrib, & + ch%symb_nrow-ch%symb_ncol, nd%contrib, ncc) + END IF + END ASSOCIATE + END DO + IF (PRESENT(contribs) .AND. ALLOCATED(nd%contribs)) THEN + DO ci = 1, SIZE(nd%contribs) + ASSOCIATE (ct => contribs(nd%contribs(ci))) + IF (ct%cn > 0) THEN + IF (ALLOCATED(cache)) DEALLOCATE(cache) + ALLOCATE(cache(ct%cn)) + DO k = 1, ct%cn + cache(k) = tls_pmap(ct%rlist(k)) - nd%ncol + END DO + CALL assemble_expected_contrib(1_ip_, ct%cn, ct%cn, & + cache, ct%val, ct%cn, nd%contrib, ncc) + END IF + END ASSOCIATE + END DO + END IF + END IF + END ASSOCIATE + END SUBROUTINE factor_one_node + + !> Factor the whole subtree with an OpenMP task DAG: one task per node, with + !! dependencies encoding the elimination tree. A node's task writes its own + !! sync slot and reads its parent's; since children are created before the + !! parent (postorder) and read the parent's slot, the parent's write waits + !! for all children (WAR) -- so a node runs as soon as its children are + !! done, with no level barriers. Falls back to serial without OpenMP. + SUBROUTINE factor_subtree_delay(node, nnodes, n, action, u, small, nb, & + posdef, ok, contribs, & + small_subtree_threshold, & + failed_tpp, alloc_ok) + TYPE(dmf_node), INTENT(INOUT) :: node(:) + INTEGER(ip_), INTENT(IN) :: nnodes, n, nb + LOGICAL, INTENT(IN) :: action, posdef + REAL(rp_), INTENT(IN) :: u, small + LOGICAL, INTENT(OUT) :: ok + TYPE(subtree_contrib_t), INTENT(IN), OPTIONAL :: contribs(:) + INTEGER(long_), INTENT(IN), OPTIONAL :: small_subtree_threshold + LOGICAL, INTENT(IN), OPTIONAL :: failed_tpp + LOGICAL, INTENT(OUT), OPTIONAL :: alloc_ok ! .false. on OOM + LOGICAL :: ftpp, aok + INTEGER(ip_) :: p, pp, q, lop + INTEGER(ip_), ALLOCATABLE :: sync(:), lo(:) + INTEGER(long_), ALLOCATABLE :: flops(:) + LOGICAL, ALLOCATABLE :: is_root(:), skip_node(:) + INTEGER(long_) :: thresh, own + INTEGER(ip_) :: kk + LOGICAL :: nok, naok + + ok = .TRUE.; aok = .TRUE. + ftpp = .TRUE.; IF (PRESENT(failed_tpp)) ftpp = failed_tpp + IF (nnodes <= 0) RETURN + ALLOCATE(sync(0:nnodes)); sync = 0 ! slot 0 = sentinel for roots + + ! ---- small leaf subtrees: group a complete leaf subtree whose flop count + ! is below small_subtree_threshold and factor it in a single (serial) task + ! for cache locality (port of SmallLeaf{Symbolic,Numeric}Subtree). The + ! group task keeps the exact dependencies of its root node, and its + ! members form a complete subtree, so children are always factored + ! before parents. + ALLOCATE(is_root(nnodes), skip_node(nnodes)) + is_root = .FALSE.; skip_node = .FALSE. + thresh = 0_long_ + IF (PRESENT(small_subtree_threshold)) thresh = small_subtree_threshold + IF (thresh > 0_long_) THEN + ALLOCATE(lo(nnodes), flops(0:nnodes)) + flops = 0_long_ + DO p = 1, nnodes + lo(p) = p + END DO + DO p = 1, nnodes + own = 0_long_ + DO kk = 0, node(p)%symb_ncol-1 + own = own + INT(node(p)%symb_nrow-kk, long_)**2 + END DO + flops(p) = flops(p) + own + ! penalise nodes that receive a foreign subtree contribution (a + ! parttree boundary), + ! so a small-leaf group never crosses such a boundary + IF (ALLOCATED(node(p)%contribs)) THEN + IF (SIZE(node(p)%contribs) > 0) flops(p) = flops(p) + thresh + END IF + pp = node(p)%parent + IF (pp >= 1) THEN + flops(pp) = flops(pp) + flops(p) + lo(pp) = MIN(lo(pp), lo(p)) + END IF + END DO + DO p = 1, nnodes + pp = node(p)%parent + IF (p > lo(p) .AND. flops(p) < thresh) THEN + IF (pp == 0) THEN + is_root(p) = .TRUE. + ELSE IF (flops(pp) >= thresh) THEN + is_root(p) = .TRUE. + END IF + IF (is_root(p)) THEN + DO q = lo(p), p-1 + skip_node(q) = .TRUE. + END DO + END IF + END IF + END DO + END IF + + !$omp parallel default(shared) private(p, pp, q, lop, nok, naok) + !$omp single + DO p = 1, nnodes + IF (skip_node(p)) CYCLE ! folded into its group's root task + pp = node(p)%parent + IF (is_root(p)) THEN + lop = lo(p) + !$omp task firstprivate(p, pp, lop) private(q, nok, naok) & + !$omp default(shared) & + !$omp depend(inout: sync(p)) depend(in: sync(pp)) + DO q = lop, p ! factor the whole leaf subtree + CALL factor_one_node(node, q, nnodes, n, action, u, small, nb, & + posdef, nok, contribs, failed_tpp = ftpp, & + node_aok = naok) + IF (.NOT. nok) THEN + !$omp atomic write + ok = .FALSE. + END IF + IF (.NOT. naok) THEN + !$omp atomic write + aok = .FALSE. + END IF + END DO + !$omp end task + ELSE + !$omp task firstprivate(p, pp) private(nok, naok) default(shared) & + !$omp depend(inout: sync(p)) depend(in: sync(pp)) + CALL factor_one_node(node, p, nnodes, n, action, u, small, nb, & + posdef, nok, contribs, failed_tpp = ftpp, & + node_aok = naok) + IF (.NOT. nok) THEN + !$omp atomic write + ok = .FALSE. + END IF + IF (.NOT. naok) THEN + !$omp atomic write + aok = .FALSE. + END IF + !$omp end task + END IF + END DO + !$omp end single + ! the implicit barrier at end single guarantees every task has completed, + ! so each team thread can now free its own threadprivate scratch (tls_pmap + ! persists past the region otherwise and leaks one copy per worker thread) + IF (ALLOCATED(tls_pmap)) DEALLOCATE(tls_pmap) + !$omp end parallel + + IF (PRESENT(alloc_ok)) alloc_ok = aok + DEALLOCATE(sync, is_root, skip_node) + IF (ALLOCATED(lo)) DEALLOCATE(lo, flops) + END SUBROUTINE factor_subtree_delay + + SUBROUTINE extract_contrib(nd, ct) + TYPE(dmf_node), INTENT(IN) :: nd + TYPE(subtree_contrib_t), INTENT(OUT) :: ct + INTEGER(ip_) :: cm, i, j, k, lddelay, dc + cm = nd%symb_nrow - nd%symb_ncol + ct%cn = cm; ct%ndelay = nd%ndelay_out + IF (cm > 0) THEN + ALLOCATE(ct%rlist(cm)) + ct%rlist = nd%rlist(nd%symb_ncol+1 : nd%symb_nrow) + ALLOCATE(ct%val(cm,cm)); ct%val = nd%contrib + END IF + IF (ct%ndelay > 0) THEN + ALLOCATE(ct%delay_perm(ct%ndelay)) + ct%delay_perm = nd%perm(nd%nelim+1 : nd%ncol) + lddelay = ct%ndelay + cm + ALLOCATE(ct%delay_val(lddelay, ct%ndelay)); ct%delay_val = 0._rp_ + DO i = 1, ct%ndelay + dc = nd%nelim + i + DO j = i, ct%ndelay + ct%delay_val(j, i) = nd%lcol(nd%nelim + j, dc) + END DO + DO k = 1, cm + ct%delay_val(ct%ndelay + k, i) = nd%lcol(nd%ncol + k, dc) + END DO + END DO + END IF + END SUBROUTINE extract_contrib + + SUBROUTINE build_cache(ch, pmap, cache) + TYPE(dmf_node), INTENT(IN) :: ch + INTEGER(ip_), INTENT(IN) :: pmap(:) + INTEGER(ip_), ALLOCATABLE, INTENT(INOUT) :: cache(:) + INTEGER(ip_) :: kk, ncc + ncc = ch%symb_nrow - ch%symb_ncol + IF (ALLOCATED(cache)) DEALLOCATE(cache) + ALLOCATE(cache(MAX(ncc,1_ip_))) + DO kk = 1, ncc + cache(kk) = pmap(ch%rlist(ch%symb_ncol + kk)) + END DO + END SUBROUTINE build_cache + +! ===================== tree solves (per phase, multi-RHS) ============= + SUBROUTINE subtree_solve_fwd_delay(node, nnodes, nrhs, x, ldx) + TYPE(dmf_node), INTENT(IN) :: node(:) + INTEGER(ip_), INTENT(IN) :: nnodes, nrhs, ldx + REAL(rp_), INTENT(INOUT) :: x(ldx, *) + INTEGER(ip_) :: p + INTEGER(ip_), ALLOCATABLE :: gl(:) + REAL(rp_), ALLOCATABLE :: xf(:,:) + DO p = 1, nnodes + CALL gl_of(node(p), gl) + ALLOCATE(xf(node(p)%nrow, nrhs)) + CALL gather(x, ldx, gl, node(p)%nrow, nrhs, xf) + CALL ldlt_app_solve_fwd(node(p)%nrow, node(p)%nelim, node(p)%lcol, & + node(p)%ldl, nrhs, xf, node(p)%nrow) + CALL scatter(x, ldx, gl, node(p)%nrow, nrhs, xf) + DEALLOCATE(xf, gl) + END DO + END SUBROUTINE subtree_solve_fwd_delay + + SUBROUTINE subtree_solve_diag_delay(node, nnodes, nrhs, x, ldx) + TYPE(dmf_node), INTENT(IN) :: node(:) + INTEGER(ip_), INTENT(IN) :: nnodes, nrhs, ldx + REAL(rp_), INTENT(INOUT) :: x(ldx, *) + INTEGER(ip_) :: p + INTEGER(ip_), ALLOCATABLE :: gl(:) + REAL(rp_), ALLOCATABLE :: xe(:,:) + DO p = 1, nnodes + IF (node(p)%nelim <= 0) CYCLE + ALLOCATE(gl(node(p)%nelim)); gl = node(p)%perm(1:node(p)%nelim) + ALLOCATE(xe(node(p)%nelim, nrhs)) + CALL gather(x, ldx, gl, node(p)%nelim, nrhs, xe) + CALL ldlt_app_solve_diag(node(p)%nelim, node(p)%d, nrhs, xe, & + node(p)%nelim) + CALL scatter(x, ldx, gl, node(p)%nelim, nrhs, xe) + DEALLOCATE(xe, gl) + END DO + END SUBROUTINE subtree_solve_diag_delay + + SUBROUTINE subtree_solve_bwd_delay(node, nnodes, nrhs, x, ldx) + TYPE(dmf_node), INTENT(IN) :: node(:) + INTEGER(ip_), INTENT(IN) :: nnodes, nrhs, ldx + REAL(rp_), INTENT(INOUT) :: x(ldx, *) + INTEGER(ip_) :: p + INTEGER(ip_), ALLOCATABLE :: gl(:) + REAL(rp_), ALLOCATABLE :: xf(:,:) + DO p = nnodes, 1, -1 + CALL gl_of(node(p), gl) + ALLOCATE(xf(node(p)%nrow, nrhs)) + CALL gather(x, ldx, gl, node(p)%nrow, nrhs, xf) + CALL ldlt_app_solve_bwd(node(p)%nrow, node(p)%nelim, node(p)%lcol, & + node(p)%ldl, nrhs, xf, node(p)%nrow) + CALL scatter(x, ldx, gl, node(p)%nrow, nrhs, xf) + DEALLOCATE(xf, gl) + END DO + END SUBROUTINE subtree_solve_bwd_delay + + SUBROUTINE gl_of(nd, gl) + TYPE(dmf_node), INTENT(IN) :: nd + INTEGER(ip_), ALLOCATABLE, INTENT(INOUT) :: gl(:) + INTEGER(ip_) :: i + IF (ALLOCATED(gl)) DEALLOCATE(gl) + ALLOCATE(gl(nd%nrow)) + DO i = 1, nd%ncol + gl(i) = nd%perm(i) + END DO + DO i = nd%ncol+1, nd%nrow + gl(i) = nd%rlist(i - nd%ndelay_in) + END DO + END SUBROUTINE gl_of + + SUBROUTINE gather(x, ldx, gl, m, nrhs, xf) + INTEGER(ip_), INTENT(IN) :: ldx, m, nrhs, gl(:) + REAL(rp_), INTENT(IN) :: x(ldx, *) + REAL(rp_), INTENT(OUT) :: xf(m, nrhs) + INTEGER(ip_) :: i, r + DO r = 1, nrhs + DO i = 1, m + xf(i, r) = x(gl(i), r) + END DO + END DO + END SUBROUTINE gather + + SUBROUTINE scatter(x, ldx, gl, m, nrhs, xf) + INTEGER(ip_), INTENT(IN) :: ldx, m, nrhs, gl(:) + REAL(rp_), INTENT(INOUT) :: x(ldx, *) + REAL(rp_), INTENT(IN) :: xf(m, nrhs) + INTEGER(ip_) :: i, r + DO r = 1, nrhs + DO i = 1, m + x(gl(i), r) = xf(i, r) + END DO + END DO + END SUBROUTINE scatter + + END MODULE GALAHAD_SLBLT_factor_precision diff --git a/src/slblt/slblt_factort.F90 b/src/slblt/slblt_factort.F90 new file mode 100644 index 0000000000..9eb60e0d9f --- /dev/null +++ b/src/slblt/slblt_factort.F90 @@ -0,0 +1,572 @@ +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 +! +! Unit tests for the pure-Fortran SLBLT kernels (GALAHAD_SLBLT_factor_precision), +! templated over precision/integer via the usual _precision mechanism. Two levels: +! * per-routine kernel tests: calc_ld, ldlt_tpp_factor, ldlt_blocked_factor, +! factor_node_indef, assemble_expected(_contrib), ldlt_app_solve_{fwd,diag,bwd}; +! * driver/integration tests: 2-node SPD, 3-level (post-assembly), 2x2-pivot +! indefinite, forced delayed pivots, blocked path, foreign child_contrib. + +#include "galahad_modules.h" + + PROGRAM GALAHAD_SLBLT_factor_test_program + USE GALAHAD_KINDS_precision, ONLY : ip_, rp_ + USE GALAHAD_SLBLT_factor_precision, ONLY : dmf_node, & + subtree_contrib_t, factor_subtree_delay, extract_contrib, & + subtree_solve_fwd_delay, subtree_solve_diag_delay, & + subtree_solve_bwd_delay, & + calc_ld, ldlt_tpp_factor, ldlt_blocked_factor, factor_node_indef, & + block_ldlt, ldlt_app_factor, & + assemble_expected, assemble_expected_contrib, & + ldlt_app_solve_fwd, ldlt_app_solve_diag, ldlt_app_solve_bwd + IMPLICIT NONE + INTEGER( ip_ ) :: nfail + nfail = 0 + + ! per-routine kernel tests + CALL case_calc_ld( nfail ) + CALL case_ldlt_tpp( nfail ) + CALL case_ldlt_blocked( nfail ) + CALL case_block_ldlt( nfail ) + CALL case_ldlt_app( nfail ) + CALL case_ldlt_app_rec( nfail ) + CALL case_ldlt_app_aggr( nfail ) + CALL case_singular_action( nfail ) + CALL case_factor_node( nfail ) + CALL case_assemble( nfail ) + CALL case_app_solve( nfail ) + ! driver / integration tests + CALL case_posdef( nfail ) + CALL case_2node_spd( nfail ) + CALL case_3level_spd( nfail ) + CALL case_indef_2x2( nfail ) + CALL case_delay( nfail ) + CALL case_blocked( nfail ) + CALL case_child_contrib( nfail ) + + IF ( nfail == 0 ) THEN + WRITE( 6, "( ' slblt fortran kernels: all tests passed' )" ) + ELSE + WRITE( 6, "( ' slblt fortran kernels: ', I0, ' FAILED' )" ) nfail + STOP 1 + END IF + + CONTAINS + + ! ---- helpers ---- + REAL( rp_ ) FUNCTION tol( A ) + REAL( rp_ ), INTENT( IN ) :: A(:,:) + tol = SQRT( EPSILON( 1.0_rp_ ) ) * MAX( MAXVAL( ABS( A ) ), 1.0_rp_ ) * 100.0_rp_ + END FUNCTION tol + + SUBROUTINE set_node( nd, ncol, rlist, parent ) + TYPE( dmf_node ), INTENT( OUT ) :: nd + INTEGER( ip_ ), INTENT( IN ) :: ncol, rlist(:), parent + nd%symb_ncol = ncol; nd%symb_nrow = SIZE( rlist ); nd%parent = parent + ALLOCATE( nd%rlist( nd%symb_nrow ) ); nd%rlist = rlist + END SUBROUTINE set_node + + SUBROUTINE set_a( nd, ai, aj, av ) + TYPE( dmf_node ), INTENT( INOUT ) :: nd + INTEGER( ip_ ), INTENT( IN ) :: ai(:), aj(:) + REAL( rp_ ), INTENT( IN ) :: av(:) + nd%ai = ai; nd%aj = aj; nd%av = av + END SUBROUTINE set_a + + SUBROUTINE solve_check( node, nn, A, b, n, nb, label, nfail, posdef ) + TYPE( dmf_node ), INTENT( INOUT ) :: node(:) + INTEGER( ip_ ), INTENT( IN ) :: nn, n, nb + REAL( rp_ ), INTENT( IN ) :: A(n,n), b(n) + CHARACTER( * ), INTENT( IN ) :: label + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + LOGICAL, OPTIONAL, INTENT( IN ) :: posdef + REAL( rp_ ) :: x(n,1), err + LOGICAL :: ok, pd + pd = .FALSE. ; IF ( PRESENT( posdef ) ) pd = posdef + CALL factor_subtree_delay( node, nn, n, .TRUE., 0.01_rp_, & + EPSILON( 1.0_rp_ ), nb, pd, ok ) + x( :, 1 ) = b + CALL subtree_solve_fwd_delay ( node, nn, 1_ip_, x, n ) + CALL subtree_solve_diag_delay( node, nn, 1_ip_, x, n ) + CALL subtree_solve_bwd_delay ( node, nn, 1_ip_, x, n ) + err = MAXVAL( ABS( MATMUL( A, x( :, 1 ) ) - b ) ) + IF ( ok .AND. err <= tol( A ) ) THEN + WRITE( 6, "( ' ok : ', A )" ) label + ELSE + WRITE( 6, "( ' FAIL : ', A, ' err=', ES10.3 )" ) label, err + nfail = nfail + 1 + END IF + END SUBROUTINE solve_check + + SUBROUTINE report( cond, label, nfail ) + LOGICAL, INTENT( IN ) :: cond + CHARACTER( * ), INTENT( IN ) :: label + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + IF ( cond ) THEN + WRITE( 6, "( ' ok : ', A )" ) label + ELSE + WRITE( 6, "( ' FAIL : ', A )" ) label + nfail = nfail + 1 + END IF + END SUBROUTINE report + + !> Solve A x = b from a completed dense LDL^T factor (L in fac, perm, d), + !! using the ldlt_app fwd/diag/bwd kernels. + SUBROUTINE dense_solve( n, fac, perm, d, b, x ) + INTEGER( ip_ ), INTENT( IN ) :: n + REAL( rp_ ), INTENT( IN ) :: fac(n,n), d(*) + INTEGER( ip_ ), INTENT( IN ) :: perm(n) + REAL( rp_ ), INTENT( IN ) :: b(n) + REAL( rp_ ), INTENT( OUT ) :: x(n) + REAL( rp_ ) :: bp(n) + INTEGER( ip_ ) :: i + DO i = 1, n + bp(i) = b( perm(i) ) + END DO + CALL ldlt_app_solve_fwd ( n, n, fac, n, 1_ip_, bp, n ) + CALL ldlt_app_solve_diag( n, d, 1_ip_, bp, n ) + CALL ldlt_app_solve_bwd ( n, n, fac, n, 1_ip_, bp, n ) + DO i = 1, n + x( perm(i) ) = bp(i) + END DO + END SUBROUTINE dense_solve + + ! ---- per-routine kernel tests ---- + + SUBROUTINE case_calc_ld( nfail ) + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + INTEGER( ip_ ), PARAMETER :: m = 4, n = 2 + REAL( rp_ ) :: L(m,n), d(2*n+2), LD(m,n), err, dc + INTEGER( ip_ ) :: r, c + DO c = 1, n ; DO r = 1, m ; L(r,c) = 0.5_rp_*r + c ; END DO ; END DO + d = 0.0_rp_ + d(1) = 2.0_rp_ ! D^-1 for col 1 (=> D = 0.5); also finite 2x2-marker for col 0 + d(3) = 4.0_rp_ ! D^-1 for col 2 (=> D = 0.25) + CALL calc_ld( .FALSE., m, n, L, m, d, LD, m ) + err = 0.0_rp_ + DO c = 1, n + dc = 1.0_rp_ / d( 2*(c-1)+1 ) + DO r = 1, m + err = MAX( err, ABS( LD(r,c) - dc*L(r,c) ) ) + END DO + END DO + CALL report( err <= SQRT( EPSILON( 1.0_rp_ ) ), "calc_ld (LD = L*D)", nfail ) + END SUBROUTINE case_calc_ld + + SUBROUTINE spd_matrix( n, A ) + INTEGER( ip_ ), INTENT( IN ) :: n + REAL( rp_ ), INTENT( OUT ) :: A(n,n) + INTEGER( ip_ ) :: i, j + DO j = 1, n ; DO i = 1, n + A(i,j) = 1.0_rp_ / ( 1.0_rp_ + ABS( i - j ) ) + END DO ; END DO + DO i = 1, n + A(i,i) = A(i,i) + REAL( n, rp_ ) + END DO + END SUBROUTINE spd_matrix + + SUBROUTINE case_ldlt_tpp( nfail ) + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + INTEGER( ip_ ), PARAMETER :: n = 8 + REAL( rp_ ) :: A(n,n), fac(n,n), d(2*n+2), ldw(n,2), aleft(1,1), b(n), x(n) + INTEGER( ip_ ) :: perm(n), flag, nelim, i + CALL spd_matrix( n, A ) + fac = A ; DO i = 1, n ; perm(i) = i ; END DO + nelim = ldlt_tpp_factor( n, n, perm, fac, n, d, ldw, n, .TRUE., 0.01_rp_, & + EPSILON( 1.0_rp_ ), 0_ip_, aleft, 1_ip_, flag ) + DO i = 1, n ; b(i) = REAL( i, rp_ ) ; END DO + CALL dense_solve( n, fac, perm, d, b, x ) + CALL report( nelim == n .AND. MAXVAL( ABS( MATMUL(A,x) - b ) ) <= tol(A), & + "ldlt_tpp_factor + solve", nfail ) + END SUBROUTINE case_ldlt_tpp + + SUBROUTINE case_ldlt_blocked( nfail ) + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + INTEGER( ip_ ), PARAMETER :: n = 10 + REAL( rp_ ) :: A(n,n), fac(n,n), d(2*n+2), b(n), x(n) + INTEGER( ip_ ) :: perm(n), flag, nelim, i + CALL spd_matrix( n, A ) + fac = A ; DO i = 1, n ; perm(i) = i ; END DO + nelim = ldlt_blocked_factor( n, n, perm, fac, n, d, 0.01_rp_, & + EPSILON( 1.0_rp_ ), .TRUE., 3_ip_, flag ) + DO i = 1, n ; b(i) = REAL( n - i + 1, rp_ ) ; END DO + CALL dense_solve( n, fac, perm, d, b, x ) + CALL report( nelim == n .AND. MAXVAL( ABS( MATMUL(A,x) - b ) ) <= tol(A), & + "ldlt_blocked_factor (nb=3) + solve", nfail ) + END SUBROUTINE case_ldlt_blocked + + !> block_ldlt (Bunch-Kaufman) on a full block; matrix designed to force a + !! 2x2 pivot (small diagonal, large off-diagonal in the leading 2x2). + SUBROUTINE case_block_ldlt( nfail ) + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + INTEGER( ip_ ), PARAMETER :: n = 4 + REAL( rp_ ) :: A(n,n), fac(n,n), d(2*n+2), ldw(n,n), b(n), x(n) + INTEGER( ip_ ) :: perm(n), lperm(n), flag, i + A = RESHAPE( [ 0.1_rp_, 3.0_rp_, 0.0_rp_, 0.0_rp_, & + 3.0_rp_, 0.1_rp_, 0.0_rp_, 0.0_rp_, & + 0.0_rp_, 0.0_rp_, 5.0_rp_, 1.0_rp_, & + 0.0_rp_, 0.0_rp_, 1.0_rp_, -5.0_rp_ ], [n,n] ) + fac = A ; DO i = 1, n ; perm(i) = i ; lperm(i) = i-1 ; END DO + CALL block_ldlt( 0_ip_, perm, fac, n, d, ldw, .TRUE., 0.01_rp_, & + EPSILON( 1.0_rp_ ), lperm, n, flag ) + DO i = 1, n ; b(i) = REAL( i, rp_ ) ; END DO + CALL dense_solve( n, fac, perm, d, b, x ) + CALL report( flag == 0 .AND. MAXVAL( ABS( MATMUL(A,x) - b ) ) <= tol(A), & + "block_ldlt (Bunch-Kaufman) + solve", nfail ) + END SUBROUTINE case_block_ldlt + + !> singular front: with action=.FALSE. the a-posteriori pivoted factor must + !! ABORT (flag /= 0), not silently report a full elimination; with + !! action=.TRUE. it must NOT spuriously abort (null pivots are zeroed/delayed). + !! Guards the pivoted-pass singular detection (block_ldlt / ldlt_tpp flag). + SUBROUTINE case_singular_action( nfail ) + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + INTEGER( ip_ ), PARAMETER :: n = 8 + REAL( rp_ ) :: A(n,n), fac(n,n), d(2*n+2), cdum(1,1) + INTEGER( ip_ ) :: perm(n), flag, nelim, ndout, i, j + DO j = 1, n ; DO i = 1, n ; A(i,j) = 1.0_rp_ ; END DO ; END DO ! rank-1 + fac = A ; DO i = 1, n ; perm(i) = i ; END DO + nelim = ldlt_app_factor( n, n, perm, fac, n, d, 0.01_rp_, & + EPSILON( 1.0_rp_ ), .FALSE., 4_ip_, flag ) + CALL report( flag /= 0, & + "ldlt_app_factor singular, action=.FALSE. -> abort", nfail ) + fac = A ; DO i = 1, n ; perm(i) = i ; END DO + nelim = ldlt_app_factor( n, n, perm, fac, n, d, 0.01_rp_, & + EPSILON( 1.0_rp_ ), .TRUE., 4_ip_, flag ) + CALL report( flag == 0, & + "ldlt_app_factor singular, action=.TRUE. -> no abort", nfail ) + ! factor_node_indef must propagate the abort as nelim < 0 (-> ERROR_SINGULAR) + fac = A ; DO i = 1, n ; perm(i) = i ; END DO + CALL factor_node_indef( n, n, 0_ip_, fac, n, d, perm, cdum, 1_ip_, .FALSE.,& + 0.01_rp_, EPSILON( 1.0_rp_ ), n, .FALSE., nelim, & + ndout ) + CALL report( nelim < 0, & + "factor_node_indef singular, action=.FALSE. -> nelim<0", nfail ) + END SUBROUTINE case_singular_action + + !> ldlt_app_factor: a-posteriori pivoted multi-block factor (nb=4 => 3 blocks) + !! of an indefinite, diagonally dominant system. + SUBROUTINE case_ldlt_app( nfail ) + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + INTEGER( ip_ ), PARAMETER :: n = 12 + REAL( rp_ ) :: A(n,n), fac(n,n), d(2*n+2), b(n), x(n) + INTEGER( ip_ ) :: perm(n), flag, nelim, i, j + DO j = 1, n ; DO i = 1, n + A(i,j) = 1.0_rp_ / ( 1.0_rp_ + ABS( i - j ) ) + END DO ; END DO + DO i = 1, n ! alternating-sign large diagonal => indefinite + A(i,i) = MERGE( 6.0_rp_, -6.0_rp_, MOD( i, 2 ) == 0 ) + END DO + fac = A ; DO i = 1, n ; perm(i) = i ; END DO + nelim = ldlt_app_factor( n, n, perm, fac, n, d, 0.01_rp_, & + EPSILON( 1.0_rp_ ), .TRUE., 4_ip_, flag ) + DO i = 1, n ; b(i) = REAL( n - i + 1, rp_ ) ; END DO + CALL dense_solve( n, fac, perm, d, b, x ) + CALL report( nelim == n .AND. MAXVAL( ABS( MATMUL(A,x) - b ) ) <= tol(A), & + "ldlt_app_factor (APP, nb=4) + solve", nfail ) + END SUBROUTINE case_ldlt_app + + !> ldlt_app_factor with an outer block size > 32: exercises the recursive + !! inner-block (block_ldlt) factorization of the wide diagonal blocks. + SUBROUTINE case_ldlt_app_rec( nfail ) + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + INTEGER( ip_ ), PARAMETER :: n = 100 + REAL( rp_ ) :: A(n,n), fac(n,n), d(2*n+2), b(n), x(n) + INTEGER( ip_ ) :: perm(n), flag, nelim, i, j + DO j = 1, n ; DO i = 1, n + A(i,j) = 1.0_rp_ / ( 1.0_rp_ + ABS( i - j ) ) + END DO ; END DO + DO i = 1, n + A(i,i) = MERGE( 9.0_rp_, -9.0_rp_, MOD( i, 2 ) == 0 ) + END DO + fac = A ; DO i = 1, n ; perm(i) = i ; END DO + ! nb=40 > 32 => outer 40-blocks, inner 32-blocks via recursion + nelim = ldlt_app_factor( n, n, perm, fac, n, d, 0.01_rp_, & + EPSILON( 1.0_rp_ ), .TRUE., 40_ip_, flag ) + DO i = 1, n ; b(i) = 1.0_rp_ + MOD( REAL( i, rp_ ), 5.0_rp_ ) ; END DO + CALL dense_solve( n, fac, perm, d, b, x ) + CALL report( nelim == n .AND. MAXVAL( ABS( MATMUL(A,x) - b ) ) <= tol(A), & + "ldlt_app_factor (APP recursion, nb=40) + solve", nfail ) + END SUBROUTINE case_ldlt_app_rec + + !> Aggressive (unpivoted-first) path: on an SPD system it must match the + !! pivoted result bit-for-bit; on an indefinite one it falls back and still + !! yields a correct solve. + SUBROUTINE case_ldlt_app_aggr( nfail ) + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + INTEGER( ip_ ), PARAMETER :: n = 80 + REAL( rp_ ) :: A(n,n), fa(n,n), fp(n,n), da(2*n+2), dp(2*n+2), b(n), x(n) + INTEGER( ip_ ) :: pa(n), pp(n), na, np, flag, i, j + LOGICAL :: okspd, okindef + ! (a) SPD: aggressive == pivoted bit-for-bit + CALL spd_matrix( n, A ) + fa = A ; fp = A ; DO i = 1, n ; pa(i) = i ; pp(i) = i ; END DO + na = ldlt_app_factor( n, n, pa, fa, n, da, 0.01_rp_, EPSILON(1.0_rp_), & + .TRUE., 40_ip_, flag, aggressive = .TRUE. ) + np = ldlt_app_factor( n, n, pp, fp, n, dp, 0.01_rp_, EPSILON(1.0_rp_), & + .TRUE., 40_ip_, flag ) + okspd = ( na == np ) .AND. ( MAXVAL(ABS(fa-fp)) == 0.0_rp_ ) .AND. & + ( MAXVAL(ABS(da(1:2*n)-dp(1:2*n))) == 0.0_rp_ ) .AND. & + ALL( pa == pp ) + ! (b) indefinite: aggressive falls back, solve still correct + DO j = 1, n ; DO i = 1, n + A(i,j) = 1.0_rp_ / ( 1.0_rp_ + ABS( i - j ) ) + END DO ; END DO + DO i = 1, n ; A(i,i) = MERGE( 5.0_rp_, -5.0_rp_, MOD(i,2)==0 ) ; END DO + fa = A ; DO i = 1, n ; pa(i) = i ; END DO + na = ldlt_app_factor( n, n, pa, fa, n, da, 0.01_rp_, EPSILON(1.0_rp_), & + .TRUE., 40_ip_, flag, aggressive = .TRUE. ) + DO i = 1, n ; b(i) = 1.0_rp_ + MOD( REAL(i,rp_), 4.0_rp_ ) ; END DO + CALL dense_solve( n, fa, pa, da, b, x ) + okindef = ( na == n ) .AND. ( MAXVAL(ABS(MATMUL(A,x)-b)) <= tol(A) ) + CALL report( okspd, "ldlt_app aggressive == pivoted (SPD)", nfail ) + CALL report( okindef, "ldlt_app aggressive fallback (indef) + solve", nfail ) + END SUBROUTINE case_ldlt_app_aggr + + SUBROUTINE case_factor_node( nfail ) + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + INTEGER( ip_ ), PARAMETER :: n = 6 + REAL( rp_ ) :: A(n,n), fac(n,n), d(2*n+2), cdum(1,1), b(n), x(n) + INTEGER( ip_ ) :: perm(n), nelim, ndout, i + CALL spd_matrix( n, A ) + fac = A ; DO i = 1, n ; perm(i) = i ; END DO + ! square node (nrow=ncol=n): full elimination, no contribution block + CALL factor_node_indef( n, n, 0_ip_, fac, n, d, perm, cdum, 1_ip_, .TRUE., & + 0.01_rp_, EPSILON( 1.0_rp_ ), n, .FALSE., nelim, ndout ) + DO i = 1, n ; b(i) = 1.0_rp_ ; END DO + CALL dense_solve( n, fac, perm, d, b, x ) + CALL report( nelim == n .AND. ndout == 0 .AND. & + MAXVAL( ABS( MATMUL(A,x) - b ) ) <= tol(A), & + "factor_node_indef (square) + solve", nfail ) + END SUBROUTINE case_factor_node + + SUBROUTINE case_assemble( nfail ) + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + REAL( rp_ ) :: contrib(2,2), lcol(3,3), pcontrib(2,2) + INTEGER( ip_ ) :: cache(2) + LOGICAL :: ok1, ok2 + ! assemble_expected: child 2x2 contrib scattered into parent lcol cols + contrib = RESHAPE( [ 1._rp_, 2._rp_, 2._rp_, 3._rp_ ], [2,2] ) + lcol = 0.0_rp_ ; cache = [ 1_ip_, 2_ip_ ] + CALL assemble_expected( 1_ip_, 2_ip_, 2_ip_, cache, contrib, 2_ip_, lcol, & + 3_ip_, 3_ip_ ) + ok1 = ( ABS( lcol(1,1)-1._rp_ ) + ABS( lcol(2,1)-2._rp_ ) + & + ABS( lcol(2,2)-3._rp_ ) ) <= SQRT( EPSILON( 1.0_rp_ ) ) + ! assemble_expected_contrib: into a contribution block (cache >= 1) + pcontrib = 0.0_rp_ ; cache = [ 1_ip_, 2_ip_ ] + CALL assemble_expected_contrib( 1_ip_, 2_ip_, 2_ip_, cache, contrib, & + 2_ip_, pcontrib, 2_ip_ ) + ok2 = ( ABS( pcontrib(1,1)-1._rp_ ) + ABS( pcontrib(2,1)-2._rp_ ) + & + ABS( pcontrib(2,2)-3._rp_ ) ) <= SQRT( EPSILON( 1.0_rp_ ) ) + CALL report( ok1, "assemble_expected (scatter into lcol)", nfail ) + CALL report( ok2, "assemble_expected_contrib (scatter into contrib)", nfail ) + END SUBROUTINE case_assemble + + SUBROUTINE case_app_solve( nfail ) + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + INTEGER( ip_ ), PARAMETER :: n = 6, nrhs = 2 + REAL( rp_ ) :: A(n,n), fac(n,n), d(2*n+2), ldw(n,2), aleft(1,1) + REAL( rp_ ) :: B(n,nrhs), X(n,nrhs), bp(n,nrhs) + INTEGER( ip_ ) :: perm(n), flag, nelim, i, r + ! exercise the multi-RHS fwd/diag/bwd solve path + CALL spd_matrix( n, A ) + fac = A ; DO i = 1, n ; perm(i) = i ; END DO + nelim = ldlt_tpp_factor( n, n, perm, fac, n, d, ldw, n, .TRUE., 0.01_rp_, & + EPSILON( 1.0_rp_ ), 0_ip_, aleft, 1_ip_, flag ) + DO i = 1, n ; B(i,1) = REAL( i, rp_ ) ; B(i,2) = 1.0_rp_ ; END DO + DO r = 1, nrhs ; DO i = 1, n ; bp(i,r) = B( perm(i), r ) ; END DO ; END DO + CALL ldlt_app_solve_fwd ( n, n, fac, n, nrhs, bp, n ) + CALL ldlt_app_solve_diag( n, d, nrhs, bp, n ) + CALL ldlt_app_solve_bwd ( n, n, fac, n, nrhs, bp, n ) + DO r = 1, nrhs ; DO i = 1, n ; X( perm(i), r ) = bp(i,r) ; END DO ; END DO + CALL report( MAXVAL( ABS( MATMUL(A,X) - B ) ) <= tol(A), & + "ldlt_app_solve fwd/diag/bwd (multi-RHS)", nfail ) + END SUBROUTINE case_app_solve + + ! ---- driver / integration cases ---- + SUBROUTINE case_posdef( nfail ) + ! same 2-node SPD tree, factored via the Cholesky (posdef) path + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + INTEGER( ip_ ), PARAMETER :: n = 5 + REAL( rp_ ) :: A(n,n), b(n) + TYPE( dmf_node ) :: node(2) + A = RESHAPE( [ 10._rp_, 1._rp_, 2._rp_, 1._rp_, 0._rp_, & + 1._rp_,10._rp_, 1._rp_, 2._rp_, 0._rp_, & + 2._rp_, 1._rp_,10._rp_, 1._rp_, 3._rp_, & + 1._rp_, 2._rp_, 1._rp_,10._rp_, 2._rp_, & + 0._rp_, 0._rp_, 3._rp_, 2._rp_,10._rp_ ], [n,n] ) + b = [ 1._rp_,2._rp_,3._rp_,4._rp_,5._rp_ ] + CALL set_node( node(1), 2_ip_, [1_ip_,2_ip_,3_ip_,4_ip_], 2_ip_ ) + CALL set_node( node(2), 3_ip_, [3_ip_,4_ip_,5_ip_], 0_ip_ ) + CALL set_a( node(1), [1_ip_,2_ip_,3_ip_,4_ip_,2_ip_,3_ip_,4_ip_], & + [1_ip_,1_ip_,1_ip_,1_ip_,2_ip_,2_ip_,2_ip_], & + [A(1,1),A(2,1),A(3,1),A(4,1),A(2,2),A(3,2),A(4,2)] ) + CALL set_a( node(2), [1_ip_,2_ip_,3_ip_,2_ip_,3_ip_,3_ip_], & + [1_ip_,1_ip_,1_ip_,2_ip_,2_ip_,3_ip_], & + [A(3,3),A(4,3),A(5,3),A(4,4),A(5,4),A(5,5)] ) + CALL solve_check( node, 2_ip_, A, b, n, n, "2-node SPD (Cholesky posdef)", & + nfail, posdef = .TRUE. ) + END SUBROUTINE case_posdef + + SUBROUTINE case_2node_spd( nfail ) + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + INTEGER( ip_ ), PARAMETER :: n = 5 + REAL( rp_ ) :: A(n,n), b(n) + TYPE( dmf_node ) :: node(2) + A = RESHAPE( [ 10._rp_, 1._rp_, 2._rp_, 1._rp_, 0._rp_, & + 1._rp_,10._rp_, 1._rp_, 2._rp_, 0._rp_, & + 2._rp_, 1._rp_,10._rp_, 1._rp_, 3._rp_, & + 1._rp_, 2._rp_, 1._rp_,10._rp_, 2._rp_, & + 0._rp_, 0._rp_, 3._rp_, 2._rp_,10._rp_ ], [n,n] ) + b = [ 1._rp_,2._rp_,3._rp_,4._rp_,5._rp_ ] + CALL set_node( node(1), 2_ip_, [1_ip_,2_ip_,3_ip_,4_ip_], 2_ip_ ) + CALL set_node( node(2), 3_ip_, [3_ip_,4_ip_,5_ip_], 0_ip_ ) + CALL set_a( node(1), [1_ip_,2_ip_,3_ip_,4_ip_,2_ip_,3_ip_,4_ip_], & + [1_ip_,1_ip_,1_ip_,1_ip_,2_ip_,2_ip_,2_ip_], & + [A(1,1),A(2,1),A(3,1),A(4,1),A(2,2),A(3,2),A(4,2)] ) + CALL set_a( node(2), [1_ip_,2_ip_,3_ip_,2_ip_,3_ip_,3_ip_], & + [1_ip_,1_ip_,1_ip_,2_ip_,2_ip_,3_ip_], & + [A(3,3),A(4,3),A(5,3),A(4,4),A(5,4),A(5,5)] ) + CALL solve_check( node, 2_ip_, A, b, n, n, "2-node SPD", nfail ) + END SUBROUTINE case_2node_spd + + SUBROUTINE case_3level_spd( nfail ) + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + INTEGER( ip_ ), PARAMETER :: n = 4 + REAL( rp_ ) :: A(n,n), b(n) + TYPE( dmf_node ) :: node(3) + A = RESHAPE( [ 20._rp_, 2._rp_, 1._rp_, 0._rp_, & + 2._rp_,20._rp_, 3._rp_, 1._rp_, & + 1._rp_, 3._rp_,20._rp_, 2._rp_, & + 0._rp_, 1._rp_, 2._rp_,20._rp_ ], [n,n] ) + b = [ 4._rp_,3._rp_,2._rp_,1._rp_ ] + CALL set_node( node(1), 1_ip_, [1_ip_,2_ip_,3_ip_], 2_ip_ ) + CALL set_node( node(2), 1_ip_, [2_ip_,3_ip_,4_ip_], 3_ip_ ) + CALL set_node( node(3), 2_ip_, [3_ip_,4_ip_], 0_ip_ ) + CALL set_a( node(1), [1_ip_,2_ip_,3_ip_], [1_ip_,1_ip_,1_ip_], & + [A(1,1),A(2,1),A(3,1)] ) + CALL set_a( node(2), [1_ip_,2_ip_,3_ip_], [1_ip_,1_ip_,1_ip_], & + [A(2,2),A(3,2),A(4,2)] ) + CALL set_a( node(3), [1_ip_,2_ip_,2_ip_], [1_ip_,1_ip_,2_ip_], & + [A(3,3),A(4,3),A(4,4)] ) + CALL solve_check( node, 3_ip_, A, b, n, n, "3-level SPD (post-assembly)", nfail ) + END SUBROUTINE case_3level_spd + + SUBROUTINE case_indef_2x2( nfail ) + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + INTEGER( ip_ ), PARAMETER :: n = 2 + REAL( rp_ ) :: A(n,n), b(n) + TYPE( dmf_node ) :: node(1) + A = RESHAPE( [ 0.001_rp_, 1._rp_, 1._rp_, 0.001_rp_ ], [n,n] ) + b = [ 1._rp_, 2._rp_ ] + CALL set_node( node(1), 2_ip_, [1_ip_,2_ip_], 0_ip_ ) + CALL set_a( node(1), [1_ip_,2_ip_,2_ip_], [1_ip_,1_ip_,2_ip_], & + [A(1,1),A(2,1),A(2,2)] ) + CALL solve_check( node, 1_ip_, A, b, n, n, "indef 2x2", nfail ) + END SUBROUTINE case_indef_2x2 + + SUBROUTINE case_delay( nfail ) + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + INTEGER( ip_ ), PARAMETER :: n = 3 + REAL( rp_ ) :: A(n,n), b(n) + TYPE( dmf_node ) :: node(2) + ! var1 has a tiny pivot + large coupling -> delayed from leaf to root + A = RESHAPE( [ 0.001_rp_, 1._rp_, 1._rp_, & + 1._rp_, 10._rp_, 0._rp_, & + 1._rp_, 0._rp_,10._rp_ ], [n,n] ) + b = [ 1._rp_, 2._rp_, 3._rp_ ] + CALL set_node( node(1), 1_ip_, [1_ip_,2_ip_,3_ip_], 2_ip_ ) + CALL set_node( node(2), 2_ip_, [2_ip_,3_ip_], 0_ip_ ) + CALL set_a( node(1), [1_ip_,2_ip_,3_ip_], [1_ip_,1_ip_,1_ip_], & + [A(1,1),A(2,1),A(3,1)] ) + CALL set_a( node(2), [1_ip_,2_ip_], [1_ip_,2_ip_], [A(2,2),A(3,3)] ) + CALL solve_check( node, 2_ip_, A, b, n, n, "forced delay (1 col)", nfail ) + END SUBROUTINE case_delay + + SUBROUTINE case_blocked( nfail ) + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + INTEGER( ip_ ), PARAMETER :: n = 24 + REAL( rp_ ) :: A(n,n), B(n,n), rhs(n) + TYPE( dmf_node ) :: node(1) + INTEGER( ip_ ) :: i, j, k + DO j = 1, n + DO i = 1, n + B(i,j) = SIN( 0.1_rp_*i + 0.3_rp_*j ) + 0.5_rp_*COS( 0.07_rp_*i*j ) + END DO + END DO + A = MATMUL( B, TRANSPOSE( B ) ) + DO i = 1, n + A(i,i) = A(i,i) + REAL( n, rp_ ) + END DO + DO i = 1, n + rhs(i) = 1.0_rp_ + MOD( REAL( i, rp_ ), 3.0_rp_ ) + END DO + ! single dense node; factor with a small panel width to exercise blocking + CALL set_node( node(1), n, [ (i, i = 1, n) ], 0_ip_ ) + k = 0 + block + integer(ip_) :: ii, jj + integer(ip_), allocatable :: ai(:), aj(:) + real(rp_), allocatable :: av(:) + allocate( ai(n*(n+1)/2), aj(n*(n+1)/2), av(n*(n+1)/2) ) + do jj = 1, n + do ii = jj, n + k = k + 1; ai(k) = ii; aj(k) = jj; av(k) = A(ii,jj) + end do + end do + call set_a( node(1), ai, aj, av ) + end block + CALL solve_check( node, 1_ip_, A, rhs, n, 4_ip_, "blocked factor (nb=4)", nfail ) + END SUBROUTINE case_blocked + + SUBROUTINE case_child_contrib( nfail ) + INTEGER( ip_ ), INTENT( INOUT ) :: nfail + INTEGER( ip_ ), PARAMETER :: n = 5 + REAL( rp_ ) :: A(n,n) + TYPE( dmf_node ) :: mono(2), child(1), par(1) + TYPE( subtree_contrib_t ) :: ct(1) + LOGICAL :: ok + REAL( rp_ ) :: dl + A = RESHAPE( [ 10._rp_, 1._rp_, 2._rp_, 1._rp_, 0._rp_, & + 1._rp_,10._rp_, 1._rp_, 2._rp_, 0._rp_, & + 2._rp_, 1._rp_,10._rp_, 1._rp_, 3._rp_, & + 1._rp_, 2._rp_, 1._rp_,10._rp_, 2._rp_, & + 0._rp_, 0._rp_, 3._rp_, 2._rp_,10._rp_ ], [n,n] ) + ! monolithic + CALL set_node( mono(1), 2_ip_, [1_ip_,2_ip_,3_ip_,4_ip_], 2_ip_ ) + CALL set_node( mono(2), 3_ip_, [3_ip_,4_ip_,5_ip_], 0_ip_ ) + CALL set_a( mono(1), [1_ip_,2_ip_,3_ip_,4_ip_,2_ip_,3_ip_,4_ip_], & + [1_ip_,1_ip_,1_ip_,1_ip_,2_ip_,2_ip_,2_ip_], & + [A(1,1),A(2,1),A(3,1),A(4,1),A(2,2),A(3,2),A(4,2)] ) + CALL set_a( mono(2), [1_ip_,2_ip_,3_ip_,2_ip_,3_ip_,3_ip_], & + [1_ip_,1_ip_,1_ip_,2_ip_,2_ip_,3_ip_], & + [A(3,3),A(4,3),A(5,3),A(4,4),A(5,4),A(5,5)] ) + CALL factor_subtree_delay( mono, 2_ip_, n, .TRUE., 0.01_rp_, & + EPSILON(1.0_rp_), n, .FALSE., ok ) + ! split: leaf as its own subtree, contribution fed to the root + CALL set_node( child(1), 2_ip_, [1_ip_,2_ip_,3_ip_,4_ip_], 0_ip_ ) + CALL set_a( child(1), [1_ip_,2_ip_,3_ip_,4_ip_,2_ip_,3_ip_,4_ip_], & + [1_ip_,1_ip_,1_ip_,1_ip_,2_ip_,2_ip_,2_ip_], & + [A(1,1),A(2,1),A(3,1),A(4,1),A(2,2),A(3,2),A(4,2)] ) + CALL factor_subtree_delay( child, 1_ip_, n, .TRUE., 0.01_rp_, & + EPSILON(1.0_rp_), n, .FALSE., ok ) + CALL extract_contrib( child(1), ct(1) ) + CALL set_node( par(1), 3_ip_, [3_ip_,4_ip_,5_ip_], 0_ip_ ) + CALL set_a( par(1), [1_ip_,2_ip_,3_ip_,2_ip_,3_ip_,3_ip_], & + [1_ip_,1_ip_,1_ip_,2_ip_,2_ip_,3_ip_], & + [A(3,3),A(4,3),A(5,3),A(4,4),A(5,4),A(5,5)] ) + par(1)%contribs = [ 1_ip_ ] + CALL factor_subtree_delay( par, 1_ip_, n, .TRUE., 0.01_rp_, & + EPSILON(1.0_rp_), n, .FALSE., ok, contribs = ct ) + dl = MAXVAL( ABS( mono(2)%lcol( 1:mono(2)%nrow, 1:mono(2)%ncol ) - & + par(1)%lcol( 1:par(1)%nrow, 1:par(1)%ncol ) ) ) + IF ( par(1)%nelim == mono(2)%nelim .AND. & + dl <= SQRT( EPSILON( 1.0_rp_ ) ) ) THEN + WRITE( 6, "( ' ok : child_contrib == monolithic' )" ) + ELSE + WRITE( 6, "( ' FAIL : child_contrib, dL=', ES10.3 )" ) dl + nfail = nfail + 1 + END IF + END SUBROUTINE case_child_contrib + + END PROGRAM GALAHAD_SLBLT_factor_test_program diff --git a/src/ssids/ssidss.data b/src/slblt/slblts.data similarity index 100% rename from src/ssids/ssidss.data rename to src/slblt/slblts.data diff --git a/src/ssids/ssidss.f90 b/src/slblt/slblts.f90 similarity index 71% rename from src/ssids/ssidss.f90 rename to src/slblt/slblts.f90 index 6d5ecdd6b5..89890b97fa 100644 --- a/src/ssids/ssidss.f90 +++ b/src/slblt/slblts.f90 @@ -1,12 +1,12 @@ - PROGRAM SSIDS_EXAMPLE ! GALAHAD 5.3 - 2025-08-14 AT 10:30 GMT. - USE GALAHAD_SSIDS_double + PROGRAM SLBLT_EXAMPLE ! GALAHAD 5.3 - 2025-08-14 AT 10:30 GMT. + USE GALAHAD_SLBLT_double IMPLICIT NONE INTEGER, PARAMETER :: wp = KIND( 1.0D+0 ) - TYPE( ssids_inform_type ) :: inform - TYPE( ssids_akeep_type ) :: akeep - TYPE( ssids_fkeep_type ) :: fkeep - TYPE( ssids_control_type ) :: control - INTEGER :: i, n, ne, cuda_error + TYPE( slblt_inform_type ) :: inform + TYPE( slblt_akeep_type ) :: akeep + TYPE( slblt_fkeep_type ) :: fkeep + TYPE( slblt_control_type ) :: control + INTEGER :: i, n, ne, flag ! INTEGER :: j, l INTEGER, ALLOCATABLE :: ROW( : ), PTR( : ), ORDER( : ) REAL ( KIND = wp ), ALLOCATABLE :: B( : ), X( : ), VAL( : ) @@ -30,29 +30,29 @@ PROGRAM SSIDS_EXAMPLE ! GALAHAD 5.3 - 2025-08-14 AT 10:30 GMT. control%ordering = 0 ALLOCATE( ORDER( n ) ) DO i = 1, n ; ORDER( i ) = i ; END DO - CALL ssids_analyse( .FALSE., n, PTR, ROW, akeep, control, inform, & + CALL slblt_analyse( .FALSE., n, PTR, ROW, akeep, control, inform, & val = VAL, order = ORDER ) DEALLOCATE( ORDER ) ELSE - CALL ssids_analyse( .FALSE., n, PTR, ROW, akeep, control, inform, & + CALL slblt_analyse( .FALSE., n, PTR, ROW, akeep, control, inform, & val = VAL ) END IF IF ( inform%flag < 0 ) THEN WRITE( 6, '( A, I0 )' ) & - ' Failure of SSIDS_analyse with flag = ', inform%flag + ' Failure of SLBLT_analyse with flag = ', inform%flag STOP END IF ! Factorize - CALL ssids_factor( .FALSE., VAL, akeep, fkeep, control, inform, & + CALL slblt_factor( .FALSE., VAL, akeep, fkeep, control, inform, & ptr = PTR, row = ROW ) IF ( inform%flag < 0 ) THEN WRITE( 6, '( A, I0 )' ) & - ' Failure of SSIDS_factor with flag = ', inform%flag + ' Failure of SLBLT_factor with flag = ', inform%flag STOP END IF ! Solve using iterative refinement and ask for high relative accuracy X = B - CALL ssids_solve( X, akeep, fkeep, control, inform ) + CALL slblt_solve( X, akeep, fkeep, control, inform ) IF ( inform%flag == 0 ) WRITE( 6, '( A, /, ( 3F20.16 ) )' ) & ' Solution is', X ! DO j = 1, n @@ -68,7 +68,7 @@ PROGRAM SSIDS_EXAMPLE ! GALAHAD 5.3 - 2025-08-14 AT 10:30 GMT. ! END DO !write(6,*) 'b ', B ! Clean up - CALL ssids_free(akeep, fkeep, cuda_error ) + CALL slblt_free(akeep, fkeep, flag ) DEALLOCATE( VAL, ROW, PTR, X, B ) STOP - END PROGRAM SSIDS_EXAMPLE + END PROGRAM SLBLT_EXAMPLE diff --git a/src/ssids/ssidst.F90 b/src/slblt/slbltt.F90 similarity index 76% rename from src/ssids/ssidst.F90 rename to src/slblt/slbltt.F90 index f396dcc584..45c4093d1b 100644 --- a/src/ssids/ssidst.F90 +++ b/src/slblt/slbltt.F90 @@ -1,16 +1,16 @@ -! THIS VERSION: GALAHAD 5.3 - 2025-08-31 AT 10:00 GMT +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 10:00 GMT #include "galahad_modules.h" - PROGRAM GALAHAD_SSIDS_test_program + PROGRAM GALAHAD_SLBLT_test_program USE GALAHAD_KINDS_precision - USE GALAHAD_SSIDS_precision + USE GALAHAD_SLBLT_precision IMPLICIT NONE - TYPE( SSIDS_inform_type ) :: inform - TYPE( SSIDS_akeep_type ) :: akeep - TYPE( SSIDS_fkeep_type ) :: fkeep - TYPE( SSIDS_control_type ) :: control - INTEGER ( KIND = ip_ ) :: i, ordering, cuda_error + TYPE( SLBLT_inform_type ) :: inform + TYPE( SLBLT_akeep_type ) :: akeep + TYPE( SLBLT_fkeep_type ) :: fkeep + TYPE( SLBLT_control_type ) :: control + INTEGER ( KIND = ip_ ) :: i, ordering, flag ! LOGICAL :: mpi_flag INTEGER ( KIND = ip_ ), PARAMETER :: n = 5, ne = 7 INTEGER ( KIND = ip_ ) :: ORDER( n ) @@ -25,11 +25,11 @@ PROGRAM GALAHAD_SSIDS_test_program SOL = (/ 1.0_rp_, 2.0_rp_, 3.0_rp_, 4.0_rp_, 5.0_rp_ /) #ifdef REAL_32 - WRITE( 6, "( ' ssids single precision tests', / )" ) + WRITE( 6, "( ' slblt single precision tests', / )" ) #elif REAL_128 - WRITE( 6, "( ' ssids quadruple precision tests', / )" ) + WRITE( 6, "( ' slblt quadruple precision tests', / )" ) #else - WRITE( 6, "( ' ssids double precision tests', / )" ) + WRITE( 6, "( ' slblt double precision tests', / )" ) #endif ! test external ordering strategies @@ -50,10 +50,10 @@ PROGRAM GALAHAD_SSIDS_test_program IF ( ordering == 1 ) THEN DO i = 1, n ; ORDER( i ) = n - i + 1 ; END DO control%ordering = 0 - CALL SSIDS_analyse( .FALSE., n, PTR, ROW, akeep, control, inform, & + CALL SLBLT_analyse( .FALSE., n, PTR, ROW, akeep, control, inform, & val = VAL, order = ORDER ) ELSE - CALL SSIDS_analyse( .FALSE., n, PTR, ROW, akeep, control, inform, & + CALL SLBLT_analyse( .FALSE., n, PTR, ROW, akeep, control, inform, & val = VAL ) END IF IF ( inform%flag < 0 ) THEN @@ -66,7 +66,7 @@ PROGRAM GALAHAD_SSIDS_test_program ! factorize the matrix ! WRITE(6,*) ' factorize ' - CALL SSIDS_factor( .FALSE., VAL, akeep, fkeep, control, inform, & + CALL SLBLT_factor( .FALSE., VAL, akeep, fkeep, control, inform, & ptr = PTR, row = ROW ) IF ( inform%flag < 0 ) THEN WRITE( 6, "( ' fail in factorize, status = ', I0 )", & @@ -79,7 +79,7 @@ PROGRAM GALAHAD_SSIDS_test_program ! WRITE(6,*) ' solve 1 RHS' X = RHS - CALL SSIDS_solve( X, akeep, fkeep, control, inform ) + CALL SLBLT_solve( X, akeep, fkeep, control, inform ) ! WRITE(6,"( ' X = ', 5ES10.2 )" ) X( 1 : n ) ! WRITE(6,*) ' status - ', inform%flag @@ -94,7 +94,7 @@ PROGRAM GALAHAD_SSIDS_test_program ! Solve multiple RHS without refinement X2( : , 1 ) = RHS ; X2( : , 2 ) = RHS - CALL SSIDS_solve( 2_ip_, X2, n, akeep, fkeep, control, inform ) + CALL SLBLT_solve( 2_ip_, X2, n, akeep, fkeep, control, inform ) ! WRITE(6,*) ' status - ', inform%flag IF ( MAXVAL( ABS( X2( 1 : n, 1 ) - SOL( 1 : n ) ) ) & @@ -110,16 +110,16 @@ PROGRAM GALAHAD_SSIDS_test_program X = RHS ! WRITE(6,*) ' L ' - CALL SSIDS_solve( X, akeep, fkeep, control, inform, job = 1_ip_ ) + CALL SLBLT_solve( X, akeep, fkeep, control, inform, job = 1_ip_ ) IF (inform%flag /= 0 ) THEN WRITE( 6, "( ' fail ' )", advance = 'no' ) WRITE( 6, "( '' )" ) CYCLE END IF ! WRITE(6,*) ' D ' - CALL SSIDS_solve( X, akeep, fkeep, control, inform, job = 2_ip_ ) + CALL SLBLT_solve( X, akeep, fkeep, control, inform, job = 2_ip_ ) ! WRITE(6,*) ' U ' - CALL SSIDS_solve( X, akeep, fkeep, control, inform, job = 3_ip_ ) + CALL SLBLT_solve( X, akeep, fkeep, control, inform, job = 3_ip_ ) ! WRITE(6,*) ' E ' IF ( MAXVAL( ABS( X( 1 : n ) - SOL( 1: n ) ) ) & <= EPSILON( 1.0_rp_ ) ** 0.333 ) THEN @@ -131,19 +131,19 @@ PROGRAM GALAHAD_SSIDS_test_program ! enquire about factors and modify diagonals ! WRITE(6,*) ' enquire ' - CALL SSIDS_enquire_indef( akeep, fkeep, control, inform, & + CALL SLBLT_enquire_indef( akeep, fkeep, control, inform, & piv_order = ORDER, d = D ) ! WRITE(6,*) ' alter d ' - CALL SSIDS_alter( D, akeep, fkeep, control, inform) + CALL SLBLT_alter( D, akeep, fkeep, control, inform) ! free data ! WRITE(6,*) ' terminate ' - CALL SSIDS_free(akeep, fkeep, cuda_error ) + CALL SLBLT_free(akeep, fkeep, flag ) WRITE( 6, "( '' )" ) END DO ! CALL MPI_INITIALIZED( mpi_flag, i ) ! IF ( mpi_flag ) CALL MPI_FINALIZE( i ) - WRITE( 6, "( /, ' ssids tests completed' )" ) + WRITE( 6, "( /, ' slblt tests completed' )" ) STOP - END PROGRAM GALAHAD_SSIDS_test_program + END PROGRAM GALAHAD_SLBLT_test_program diff --git a/src/ssids/subtree.F90 b/src/slblt/subtree.F90 similarity index 90% rename from src/ssids/subtree.F90 rename to src/slblt/subtree.F90 index 38199527a1..91c52f4718 100644 --- a/src/ssids/subtree.F90 +++ b/src/slblt/subtree.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.3 - 2025-08-31 AT 09:50 GMT +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 09:50 GMT #include "galahad_modules.h" @@ -7,10 +7,10 @@ ! author: Jonathan Hogg ! Forked and extended for GALAHAD, Nick Gould, version 3.1, 2016 - MODULE GALAHAD_SSIDS_subtree_precision + MODULE GALAHAD_SLBLT_subtree_precision USE GALAHAD_KINDS_precision - USE GALAHAD_SSIDS_types_precision, ONLY: SSIDS_control_type, & - SSIDS_inform_type, & + USE GALAHAD_SLBLT_types_precision, ONLY: SLBLT_control_type, & + SLBLT_inform_type, & contrib_type IMPLICIT NONE @@ -104,7 +104,7 @@ FUNCTION factor_iface( this, posdef, aval, child_contrib, control, & ! scaling Scaling to be applied (if present). IMPORT symbolic_subtree_base, numeric_subtree_base, rp_ - IMPORT SSIDS_inform_type, SSIDS_control_type + IMPORT SLBLT_inform_type, SLBLT_control_type IMPORT contrib_type IMPLICIT NONE CLASS(numeric_subtree_base ), POINTER :: factor_iface @@ -113,8 +113,8 @@ FUNCTION factor_iface( this, posdef, aval, child_contrib, control, & REAL( rp_ ), dimension(*), target, intent(in) :: aval TYPE(contrib_type ), DIMENSION( : ), TARGET, & INTENT( INOUT ) :: child_contrib - TYPE( SSIDS_control_type ), INTENT( IN ) :: control - TYPE( SSIDS_inform_type) , INTENT( INOUT ) :: inform + TYPE( SLBLT_control_type ), INTENT( IN ) :: control + TYPE( SLBLT_inform_type) , INTENT( INOUT ) :: inform REAL( rp_), DIMENSION( * ), TARGET, OPTIONAL, INTENT( IN ) :: scaling END FUNCTION factor_iface @@ -151,13 +151,13 @@ SUBROUTINE solve_proc_iface( this, nrhs, x, ldx, inform ) ! ldx Leading dimension of x. ! inform Information/statistics to be returned to user. - IMPORT numeric_subtree_base, ssids_inform_type, ip_, rp_ + IMPORT numeric_subtree_base, slblt_inform_type, ip_, rp_ IMPLICIT NONE CLASS( numeric_subtree_base ), INTENT( INOUT ) :: this INTEGER( ip_ ), INTENT( IN ) :: nrhs REAL( rp_ ), DIMENSION( * ), INTENT( INOUT ) :: x INTEGER( ip_), intent(in) :: ldx - TYPE( SSIDS_inform_type ), INTENT( INOUT ) :: inform + TYPE( SLBLT_inform_type ), INTENT( INOUT ) :: inform END SUBROUTINE solve_proc_iface SUBROUTINE numeric_cleanup_iface( this ) @@ -170,4 +170,4 @@ SUBROUTINE numeric_cleanup_iface( this ) CLASS( numeric_subtree_base ), INTENT( INOUT ) :: this END SUBROUTINE numeric_cleanup_iface END INTERFACE - END MODULE GALAHAD_SSIDS_subtree_precision + END MODULE GALAHAD_SLBLT_subtree_precision diff --git a/src/ssids/types.F90 b/src/slblt/types.F90 similarity index 73% rename from src/ssids/types.F90 rename to src/slblt/types.F90 index 7ba686fce9..b504f7eb4d 100644 --- a/src/ssids/types.F90 +++ b/src/slblt/types.F90 @@ -1,6 +1,6 @@ -! THIS VERSION: GALAHAD 5.5 - 2026-04-12 AT 14:10 GMT +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 14:10 GMT -!-*-*-*-*-*- G A L A H A D _ S S I D S _ t y p e s M O D U L E *-*-*-*-*- +!-*-*-*-*-*- G A L A H A D _ S L B L T _ t y p e s M O D U L E *-*-*-*-*- #include "galahad_modules.h" @@ -8,9 +8,9 @@ ! licence: BSD licence, see LICENCE file for details ! author: Jonathan Hogg ! Forked and extended for GALAHAD, Nick Gould, version 3.1, 2016 -! Absorbed SSIDS_inform and parts of SSIDS_contrib, version 5.3, 2025 +! Absorbed SLBLT_inform and parts of SLBLT_contrib, version 5.3, 2025 - MODULE GALAHAD_SSIDS_types_precision + MODULE GALAHAD_SLBLT_types_precision USE GALAHAD_KINDS_precision !$ USE omp_lib USE, INTRINSIC :: iso_c_binding @@ -32,59 +32,57 @@ MODULE GALAHAD_SSIDS_types_precision ! success flag - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_SUCCESS = 0 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_SUCCESS = 0 ! error flags - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_CALL_SEQUENCE = -1 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_A_N_OOR = -2 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_A_PTR = -3 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_A_ALL_OOR = -4 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_SINGULAR = -5 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_NOT_POS_DEF = -6 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_PTR_ROW = -7 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_ORDER = -8 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_VAL = -9 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_X_SIZE = -10 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_JOB_OOR = -11 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_NOT_LLT = -13 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_NOT_LDLT = -14 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_NO_SAVED_SCALING = -15 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_ALLOCATION = -50 -! INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_CUDA_UNKNOWN = -51 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_CUBLAS_UNKNOWN = -52 -!$ INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_OMP_CANCELLATION = -53 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_NO_METIS = -97 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_UNIMPLEMENTED = -98 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_ERROR_UNKNOWN = -99 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_CALL_SEQUENCE = -1 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_A_N_OOR = -2 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_A_PTR = -3 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_A_ALL_OOR = -4 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_SINGULAR = -5 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_NOT_POS_DEF = -6 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_PTR_ROW = -7 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_ORDER = -8 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_VAL = -9 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_X_SIZE = -10 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_JOB_OOR = -11 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_NOT_LLT = -13 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_NOT_LDLT = -14 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_NO_SAVED_SCALING = -15 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_ALLOCATION = -50 +!$ INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_OMP_CANCELLATION = -53 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_NO_METIS = -97 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_UNIMPLEMENTED = -98 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_ERROR_UNKNOWN = -99 ! warning flags - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_WARNING_IDX_OOR = 1 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_WARNING_DUP_IDX = 2 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_WARNING_DUP_AND_OOR = 3 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_WARNING_MISSING_DIAGONAL = 4 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_WARNING_MISS_DIAG_OORDUP = 5 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_WARNING_ANALYSIS_SINGULAR = 6 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_WARNING_FACT_SINGULAR = 7 - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_WARNING_MATCH_ORD_NO_SCALE = 8 -!$ INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_WARNING_OMP_PROC_BIND = 50 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_WARNING_IDX_OOR = 1 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_WARNING_DUP_IDX = 2 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_WARNING_DUP_AND_OOR = 3 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_WARNING_MISSING_DIAGONAL = 4 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_WARNING_MISS_DIAG_OORDUP = 5 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_WARNING_ANALYSIS_SINGULAR = 6 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_WARNING_FACT_SINGULAR = 7 + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_WARNING_MATCH_ORD_NO_SCALE = 8 +!$ INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_WARNING_OMP_PROC_BIND = 50 ! solve job values - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_SOLVE_JOB_ALL = 0 !PLD(PL)^TX=B - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_SOLVE_JOB_FWD = 1 !PLX=B - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_SOLVE_JOB_DIAG = 2 !DX=B (indef) - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_SOLVE_JOB_BWD = 3 !(PL)^TX=B - INTEGER( ip_ ), PARAMETER, PUBLIC :: SSIDS_SOLVE_JOB_DIAG_BWD= 4 !D(PL)^TX=B + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_SOLVE_JOB_ALL = 0 !PLD(PL)^TX=B + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_SOLVE_JOB_FWD = 1 !PLX=B + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_SOLVE_JOB_DIAG = 2 !DX=B (indef) + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_SOLVE_JOB_BWD = 3 !(PL)^TX=B + INTEGER( ip_ ), PARAMETER, PUBLIC :: SLBLT_SOLVE_JOB_DIAG_BWD= 4 !D(PL)^TX=B ! (indef) -! NB: the below must match enum PivotMethod in cpu/cpu_iface.hxx +! pivot-method codes selected by control%pivot_method INTEGER( ip_ ), PARAMETER, PUBLIC :: PIVOT_METHOD_APP_AGGRESIVE = 1 INTEGER( ip_ ), PARAMETER, PUBLIC :: PIVOT_METHOD_APP_BLOCK = 2 INTEGER( ip_ ), PARAMETER, PUBLIC :: PIVOT_METHOD_TPP = 3 -! NB: the below must match enum FailedPivotMethod in cpu/cpu_iface.hxx +! failed-pivot-method codes selected by control%failed_pivot_method INTEGER( ip_ ), PARAMETER, PUBLIC :: FAILED_PIVOT_METHOD_TPP = 1 INTEGER( ip_ ), PARAMETER, PUBLIC :: FAILED_PIVOT_METHOD_PASS = 2 @@ -93,7 +91,7 @@ MODULE GALAHAD_SSIDS_types_precision ! D e r i v e d t y p e d e f i n i t i o n s !------------------------------------------------- -! note: below smalloc etc. types can't be in galahad_ssids_alloc module as +! note: below smalloc etc. types can't be in galahad_slblt_alloc module as ! they are used as components of later datatypes ! type for custom allocator. Used to aggregate many small allocations by @@ -137,9 +135,8 @@ MODULE GALAHAD_SSIDS_types_precision INTEGER( ip_ ) :: ndelay INTEGER( long_ ) :: rdptr ! entry into ( rebuilt ) rlist_direct INTEGER( ip_ ) :: ncpdb ! #contrib. to parent's diag. block - TYPE( C_PTR ) :: gpu_lcol -! values in factors will also include unneeded data for any columns delayed +! values in factors will also include unneeded data for any columns delayed ! from this node REAL( rp_ ), DIMENSION( : ), POINTER :: lcol @@ -171,10 +168,8 @@ MODULE GALAHAD_SSIDS_types_precision ! section to get info parameters of same name. TYPE, PUBLIC :: thread_stats - INTEGER( ip_ ) :: flag = SSIDS_SUCCESS + INTEGER( ip_ ) :: flag = SLBLT_SUCCESS INTEGER( ip_ ) :: st = 0 - INTEGER( ip_ ) :: cuda_error = 0 - INTEGER( ip_ ) :: cublas_error = 0 INTEGER( ip_ ) :: maxfront = 0 ! Maximum front size INTEGER( ip_ ) :: maxsupernode = 0 ! Maximum supernode size INTEGER( long_ ) :: num_factor = 0_long_ ! # entries in factors @@ -195,7 +190,7 @@ MODULE GALAHAD_SSIDS_types_precision ! data type for control parameters - TYPE, PUBLIC :: SSIDS_control_type + TYPE, PUBLIC :: SLBLT_control_type ! printing options @@ -220,7 +215,7 @@ MODULE GALAHAD_SSIDS_types_precision INTEGER( ip_ ) :: unit_warning = 6 -! options used ssids_analyse() and ssids_analyse_coord() +! options used slblt_analyse() and slblt_analyse_coord() ! controls choice of ordering ! 0 Order must be supplied by user @@ -241,22 +236,11 @@ MODULE GALAHAD_SSIDS_types_precision LOGICAL :: ignore_numa = .TRUE. - LOGICAL :: use_gpu = .TRUE. ! Use GPUs if present - LOGICAL :: gpu_only = .FALSE. ! FIXME: not yet implemented. - -! only assign subtree to GPU if it contains at least this many flops - - INTEGER( long_ ) :: min_gpu_work = 5*10**9_long_ - ! Maximum permissible load inbalance when dividing tree into subtrees REAL( sp_ ) :: max_load_inbalance = 1.2 -! How many times better is GPU than a single NUMA region's worth of processors - - REAL( sp_ ) :: gpu_perf_coeff = 1.0 - -! options used by ssids_factor() [both indef+posdef] +! options used by slblt_factor() [both indef+posdef] ! controls use of scaling. ! <=0: user supplied ( or no ) scaling @@ -275,13 +259,13 @@ MODULE GALAHAD_SSIDS_types_precision ! block size to use for task generation on larger nodes - INTEGER( ip_ ) :: cpu_block_size = 256 + INTEGER( ip_ ) :: block_size = 256 -! options used by ssids_factor() with posdef=.false. +! options used by slblt_factor() with posdef=.false. ! used in indefinite case only. If true and the matrix is found to be ! singular, computation continues with a warning. Otherwise, terminates -! with error SSIDS_ERROR_SINGULAR +! with error SLBLT_ERROR_SINGULAR LOGICAL :: action = .TRUE. @@ -306,11 +290,7 @@ MODULE GALAHAD_SSIDS_types_precision ! undocumented ! ------------ -! number of streams to use - - INTEGER( ip_ ) :: nstream = 1 - -! size to multiply expected memory size by when doing initial memory +! size to multiply expected memory size by when doing initial memory ! allocation to allow for delays REAL( rp_ ) :: multiplier = 1.1 @@ -334,18 +314,18 @@ MODULE GALAHAD_SSIDS_types_precision CONTAINS PROCEDURE :: print_summary_analyse PROCEDURE :: print_summary_factor - END TYPE SSIDS_control_type + END TYPE SLBLT_control_type -! data type for information returned by code, extracted from ssids_inform +! data type for information returned by code, extracted from slblt_inform - TYPE, PUBLIC :: SSIDS_inform_type + TYPE, PUBLIC :: SLBLT_inform_type ! takes one of the enumerated flag values: -! SSIDS_SUCCESS -! SSIDS_ERROR_XXX -! SSIDS_WARNING_XXX +! SLBLT_SUCCESS +! SLBLT_ERROR_XXX +! SLBLT_WARNING_XXX - INTEGER( ip_ ) :: flag = SSIDS_SUCCESS + INTEGER( ip_ ) :: flag = SLBLT_SUCCESS INTEGER( ip_ ) :: matrix_dup = 0 ! # duplicated entries. INTEGER( ip_ ) :: matrix_missing_diag = 0 ! # missing diagonal entries INTEGER( ip_ ) :: matrix_outrange = 0 ! # out-of-range entries. @@ -361,8 +341,6 @@ MODULE GALAHAD_SSIDS_types_precision INTEGER( ip_ ) :: num_two = 0 ! # 2x2 pivots used by factorization INTEGER( ip_ ) :: stat = 0 ! stat parameter TYPE( MS_auction_inform_type ) :: auction - INTEGER( ip_ ) :: cuda_error = 0 - INTEGER( ip_ ) :: cublas_error = 0 TYPE( NODEND_inform_type ) :: nodend_inform ! undocumented FIXME: should we document them? @@ -370,23 +348,19 @@ MODULE GALAHAD_SSIDS_types_precision INTEGER( ip_ ) :: not_first_pass = 0 INTEGER( ip_ ) :: not_second_pass = 0 INTEGER( ip_ ) :: nparts = 0 - INTEGER( long_ ) :: cpu_flops = 0 - INTEGER( long_ ) :: gpu_flops = 0 + INTEGER( long_ ) :: flops = 0 ! CHARACTER( C_CHAR ) :: unused( 76 ) CONTAINS PROCEDURE :: flag_to_character PROCEDURE :: print_flag PROCEDURE :: reduce - END TYPE SSIDS_inform_type + END TYPE SLBLT_inform_type -! data type to hold a contribution block, extracted from ssids_contrib +! data type to hold a contribution block, extracted from slblt_contrib ! this type represents a contribution block being passed between two -! subtrees. It exists in CPU memory, but provides a cleanup routine as -! memory management may differ between two subtrees being passed. -! (It would be nice and clean to have a procedure pointer for the cleanup, -! but alas Fortran/C interop causes severe problems, so we just have the -! owner value instead and if statements to call the right thing). +! subtrees. It exists in CPU memory and provides a cleanup routine (the +! CPU path, as only CPU subtrees exist). TYPE, PUBLIC :: contrib_type LOGICAL :: ready = .FALSE. @@ -398,17 +372,15 @@ MODULE GALAHAD_SSIDS_types_precision INTEGER( C_IP_ ), DIMENSION( : ), POINTER :: delay_perm REAL( C_RP_ ), DIMENSION( : ), POINTER :: delay_val INTEGER( ip_ ) :: lddelay - INTEGER( ip_ ) :: owner ! cleanup routine to call: 0=cpu, 1=gpu -! the following are used by CPU to call correct cleanup routine +! the following is used by the CPU cleanup routine LOGICAL( C_BOOL ) :: posdef - TYPE( C_PTR ) :: owner_ptr END TYPE contrib_type CONTAINS -!- G A L A H A D - S S I D S _ print _ summary _ analyse S U B R O U T I N E +!- G A L A H A D - S L B L T _ print _ summary _ analyse S U B R O U T I N E SUBROUTINE print_summary_analyse( this, context ) @@ -417,7 +389,7 @@ SUBROUTINE print_summary_analyse( this, context ) ! context Name of subroutine to use in printing IMPLICIT none - CLASS( SSIDS_control_type ), INTENT( IN ) :: this + CLASS( SLBLT_control_type ), INTENT( IN ) :: this CHARACTER( len=* ), INTENT( IN ) :: context INTEGER( ip_ ) :: mp @@ -435,11 +407,11 @@ SUBROUTINE print_summary_analyse( this, context ) ! non-executable statement -200 FORMAT( '( A, I15 )' ) +200 FORMAT( A, I0 ) END SUBROUTINE print_summary_analyse -!- G A L A H A D - S S I D S _ print _ summary _ factor S U B R O U T I N E - +!- G A L A H A D - S L B L T _ print _ summary _ factor S U B R O U T I N E - SUBROUTINE print_summary_factor( this, posdef, context ) @@ -450,7 +422,7 @@ SUBROUTINE print_summary_factor( this, posdef, context ) ! context Name of subroutine to use in printing IMPLICIT NONE - CLASS( SSIDS_control_type ), INTENT( IN ) :: this + CLASS( SLBLT_control_type ), INTENT( IN ) :: this LOGICAL, INTENT( IN ) :: posdef CHARACTER( LEN = * ), INTENT( IN ) :: context @@ -496,11 +468,11 @@ SUBROUTINE print_summary_factor( this, posdef, context ) ! non-executable statements -200 FORMAT( '( //, 3A, I2, A )' ) -210 FORMAT( '( // A, 5( / A ,I12 ), 5( / A, ES12.4 ) )' ) +200 FORMAT( //, 3A, I0, A ) +210 FORMAT( // A, 5( / A, I0 ), 5( / A, ES12.4 ) ) END SUBROUTINE print_summary_factor -!-*- G A L A H A D - S S I D S _ flag _ to _ character F U N C T I O N -*- +!-*- G A L A H A D - S L B L T _ flag _ to _ character F U N C T I O N -*- FUNCTION flag_to_character(this) result( msg ) @@ -508,91 +480,86 @@ FUNCTION flag_to_character(this) result( msg ) ! member function inform%flagToCharacter IMPLICIT NONE - CLASS( SSIDS_inform_type ), INTENT( IN ) :: this + CLASS( SLBLT_inform_type ), INTENT( IN ) :: this CHARACTER( LEN = 200 ) :: msg ! return value SELECT CASE( this%flag ) ! success - CASE( SSIDS_SUCCESS ) + CASE( SLBLT_SUCCESS ) msg = 'Success' ! errors - CASE( SSIDS_ERROR_CALL_SEQUENCE ) + CASE( SLBLT_ERROR_CALL_SEQUENCE ) msg = 'Error in sequence of calls.' - CASE( SSIDS_ERROR_A_N_OOR ) + CASE( SLBLT_ERROR_A_N_OOR ) msg = 'n or ne is out of range (or has changed)' - CASE( SSIDS_ERROR_A_PTR ) + CASE( SLBLT_ERROR_A_PTR ) msg = 'Error in ptr' - CASE( SSIDS_ERROR_A_ALL_OOR ) - msg = 'All entries in a column out-of-range (ssids_analyse) & - &or all entries out-of-range (ssids_analyse_coord)' - CASE( SSIDS_ERROR_SINGULAR ) + CASE( SLBLT_ERROR_A_ALL_OOR ) + msg = 'All entries in a column out-of-range (slblt_analyse) & + &or all entries out-of-range (slblt_analyse_coord)' + CASE( SLBLT_ERROR_SINGULAR ) msg = 'Matrix found to be singular' - CASE( SSIDS_ERROR_NOT_POS_DEF ) + CASE( SLBLT_ERROR_NOT_POS_DEF ) msg = 'Matrix is not positive-definite' - CASE( SSIDS_ERROR_PTR_ROW ) + CASE( SLBLT_ERROR_PTR_ROW ) msg = 'ptr and row should be present' - CASE( SSIDS_ERROR_ORDER ) + CASE( SLBLT_ERROR_ORDER ) msg = 'Either control%ordering out of range or error in user-supplied & &elimination order' - CASE( SSIDS_ERROR_X_SIZE ) + CASE( SLBLT_ERROR_X_SIZE ) msg = 'Error in size of x or nrhs' - CASE( SSIDS_ERROR_JOB_OOR ) + CASE( SLBLT_ERROR_JOB_OOR ) msg = 'job out of range' - CASE( SSIDS_ERROR_NOT_LLT ) + CASE( SLBLT_ERROR_NOT_LLT ) msg = 'Not a LL^T factorization of a positive-definite matrix' - CASE( SSIDS_ERROR_NOT_LDLT ) + CASE( SLBLT_ERROR_NOT_LDLT ) msg = 'Not a LDL^T factorization of an indefinite matrix' - CASE( SSIDS_ERROR_ALLOCATION ) + CASE( SLBLT_ERROR_ALLOCATION ) write ( msg,'( A,I6 )' ) 'Allocation error. stat parameter = ', this%stat - CASE( SSIDS_ERROR_VAL ) + CASE( SLBLT_ERROR_VAL ) msg = 'Optional argument val not present when expected' - CASE( SSIDS_ERROR_NO_SAVED_SCALING ) + CASE( SLBLT_ERROR_NO_SAVED_SCALING ) msg = 'Requested use of scaling from matching-based & &ordering but matching-based ordering not used' - CASE( SSIDS_ERROR_UNIMPLEMENTED ) + CASE( SLBLT_ERROR_UNIMPLEMENTED ) msg = 'Functionality not yet implemented' -! CASE( SSIDS_ERROR_CUDA_UNKNOWN ) -! WRITE( msg,'( 2A )' ) ' Unhandled CUDA error: ', & -! trim( cudaGetErrorString( this%cuda_error ) ) - CASE( SSIDS_ERROR_CUBLAS_UNKNOWN ) - msg = 'Unhandled CUBLAS error:' -!$ CASE( SSIDS_ERROR_OMP_CANCELLATION ) -!$ msg = 'SSIDS CPU code requires OMP cancellation to be enabled' - CASE( SSIDS_ERROR_NO_METIS ) +!$ CASE( SLBLT_ERROR_OMP_CANCELLATION ) +!$ msg = 'SLBLT CPU code requires OMP cancellation to be enabled' + CASE( SLBLT_ERROR_NO_METIS ) msg = 'MeTiS is not available' ! warnings - CASE( SSIDS_WARNING_IDX_OOR ) + CASE( SLBLT_WARNING_IDX_OOR ) msg = 'out-of-range indices detected' - CASE( SSIDS_WARNING_DUP_IDX ) + CASE( SLBLT_WARNING_DUP_IDX ) msg = 'duplicate entries detected' - CASE( SSIDS_WARNING_DUP_AND_OOR ) + CASE( SLBLT_WARNING_DUP_AND_OOR ) msg = 'out-of-range indices detected and duplicate entries detected' - CASE( SSIDS_WARNING_MISSING_DIAGONAL ) + CASE( SLBLT_WARNING_MISSING_DIAGONAL ) msg = 'one or more diagonal entries is missing' - CASE( SSIDS_WARNING_MISS_DIAG_OORDUP ) + CASE( SLBLT_WARNING_MISS_DIAG_OORDUP ) msg = 'one or more diagonal entries is missing and out-of-range and/or & &duplicate entries detected' - CASE( SSIDS_WARNING_ANALYSIS_SINGULAR ) + CASE( SLBLT_WARNING_ANALYSIS_SINGULAR ) msg = 'Matrix found to be structually singular' - CASE( SSIDS_WARNING_FACT_SINGULAR ) + CASE( SLBLT_WARNING_FACT_SINGULAR ) msg = 'Matrix found to be singular' - CASE( SSIDS_WARNING_MATCH_ORD_NO_SCALE ) + CASE( SLBLT_WARNING_MATCH_ORD_NO_SCALE ) msg = 'Matching-based ordering used but associated scaling ignored' -!$ CASE( SSIDS_WARNING_OMP_PROC_BIND ) +!$ CASE( SLBLT_WARNING_OMP_PROC_BIND ) !$ msg = 'OMP_PROC_BIND=false, this may reduce performance' CASE DEFAULT - msg = 'SSIDS Internal Error' + msg = 'SLBLT Internal Error' END SELECT RETURN END FUNCTION flag_to_character -!-*- G A L A H A D - S S I D S _ p r i n t _ f l a g S U B R O U T I N E -*- +!-*- G A L A H A D - S L B L T _ p r i n t _ f l a g S U B R O U T I N E -*- SUBROUTINE print_flag( this, control, context ) @@ -602,20 +569,20 @@ SUBROUTINE print_flag( this, control, context ) ! context name of routine to report error from IMPLICIT none - CLASS( SSIDS_inform_type ), INTENT( IN ) :: this - TYPE( SSIDS_control_type ), INTENT( IN ) :: control + CLASS( SLBLT_inform_type ), INTENT( IN ) :: this + TYPE( SLBLT_control_type ), INTENT( IN ) :: control CHARACTER( LEN = * ), INTENT( IN ) :: context ! local variables CHARACTER( LEN = 200 ) :: msg - IF ( this%flag == SSIDS_SUCCESS ) RETURN ! Nothing to print + IF ( this%flag == SLBLT_SUCCESS ) RETURN ! Nothing to print IF ( control%print_level < 0 ) RETURN ! No printing ! warning - IF ( this%flag > SSIDS_SUCCESS ) THEN + IF ( this%flag > SLBLT_SUCCESS ) THEN IF ( control%unit_warning < 0 ) RETURN ! printing supressed WRITE( control%unit_warning,'( / 3A, I0 )' ) ' Warning from ', & TRIM( context ), '. Warning flag = ', this%flag @@ -632,7 +599,7 @@ SUBROUTINE print_flag( this, control, context ) END SUBROUTINE print_flag -!-*-*-*- G A L A H A D - S S I D S _ r e d u c e S U B R O U T I N E -*-*-*- +!-*-*-*- G A L A H A D - S L B L T _ r e d u c e S U B R O U T I N E -*-*-*- SUBROUTINE reduce( this, other ) @@ -643,8 +610,8 @@ SUBROUTINE reduce( this, other ) ! other object to reduce values from IMPLICIT NONE - CLASS( SSIDS_inform_type ), INTENT( INOUT ) :: this - CLASS( SSIDS_inform_type ), INTENT( IN ) :: other + CLASS( SLBLT_inform_type ), INTENT( INOUT ) :: this + CLASS( SLBLT_inform_type ), INTENT( IN ) :: other IF ( this%flag < 0 .OR. other%flag < 0 ) THEN @@ -673,15 +640,12 @@ SUBROUTINE reduce( this, other ) this%num_two = this%num_two + other%num_two IF ( other%stat /= 0 ) this%stat = other%stat ! FIXME: %auction ??? - IF ( other%cuda_error /= 0 ) this%cuda_error = other%cuda_error - IF ( other%cublas_error /= 0 ) this%cublas_error = other%cublas_error this%not_first_pass = this%not_first_pass + other%not_first_pass this%not_second_pass = this%not_second_pass + other%not_second_pass this%nparts = this%nparts + other%nparts - this%cpu_flops = this%cpu_flops + other%cpu_flops - this%gpu_flops = this%gpu_flops + other%gpu_flops + this%flops = this%flops + other%flops RETURN END SUBROUTINE reduce - END MODULE GALAHAD_SSIDS_types_precision + END MODULE GALAHAD_SLBLT_types_precision diff --git a/src/sllsb/SLLSB.template b/src/sllsb/SLLSB.template index 6a68714e38..6b539d2ca6 100644 --- a/src/sllsb/SLLSB.template +++ b/src/sllsb/SLLSB.template @@ -50,6 +50,6 @@ ! deallocate-error-fatal no ! generate-sif-file no ! generate-qplib-file no -! symmetric-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt ! sif-file-name SLLSBPROB.SIF ! qplib-file-name SLLSBPROB.qplib diff --git a/src/sllsb/sllsb.F90 b/src/sllsb/sllsb.F90 index 057e3e60c3..3bbe815ac5 100644 --- a/src/sllsb/sllsb.F90 +++ b/src/sllsb/sllsb.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.5 - 2026-04-01 AT 13:50 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 13:50 GMT. #include "galahad_modules.h" @@ -227,7 +227,7 @@ SUBROUTINE SLLSB_read_specfile( control, device, alt_specname ) ! deallocate-error-fatal F ! generate-sif-file F ! generate-qplib-file F -! symmetric-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt ! sif-file-name SLLSBPROB.SIF ! qplib-file-name SLLSBPROB.qplib ! output-line-prefix "" diff --git a/src/sllsb/sllsbt.F90 b/src/sllsb/sllsbt.F90 index 8a176ce125..dc6a3eef57 100644 --- a/src/sllsb/sllsbt.F90 +++ b/src/sllsb/sllsbt.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.5 - 2026-01-19 AT 10:30 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 10:30 GMT. #include "galahad_modules.h" PROGRAM GALAHAD_SLLSB_EXAMPLE USE GALAHAD_KINDS_precision @@ -14,7 +14,7 @@ PROGRAM GALAHAD_SLLSB_EXAMPLE INTEGER ( KIND = ip_ ) :: data_storage_type, i, status, scratch_out = 56 CHARACTER ( len = 1 ) :: st CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = REPEAT( ' ', 30 ) -! symmetric_linear_solver = 'ssids' +! symmetric_linear_solver = 'slblt' ! symmetric_linear_solver = 'ma97 ' symmetric_linear_solver = 'sytr ' diff --git a/src/sllsb/sllsbti.F90 b/src/sllsb/sllsbti.F90 index b4329c0582..e523345cd5 100644 --- a/src/sllsb/sllsbti.F90 +++ b/src/sllsb/sllsbti.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.5 - 2026-01-19 AT 10:30 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 10:30 GMT. #include "galahad_modules.h" PROGRAM GALAHAD_SLLSB_interface_test USE GALAHAD_KINDS_precision @@ -19,7 +19,7 @@ PROGRAM GALAHAD_SLLSB_interface_test INTEGER ( KIND = ip_ ), ALLOCATABLE, DIMENSION( : ) :: X_stat, COHORT CHARACTER ( len = 2 ) :: st CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = REPEAT( ' ', 30 ) -! symmetric_linear_solver = 'ssids' +! symmetric_linear_solver = 'slblt' ! symmetric_linear_solver = 'ma97 ' symmetric_linear_solver = 'sytr ' diff --git a/src/sls/C/sls_ciface.F90 b/src/sls/C/sls_ciface.F90 index 6ea787b888..292a6ed74a 100644 --- a/src/sls/C/sls_ciface.F90 +++ b/src/sls/C/sls_ciface.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.3 - 2025-08-13 AT 11:10 GMT +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 11:10 GMT #include "galahad_modules.h" #include "galahad_cfunctions.h" @@ -77,11 +77,11 @@ MODULE GALAHAD_SLS_precision_ciface copy_ma97_info_out => copy_info_out, & copy_ma97_control_in => copy_control_in - USE GALAHAD_SSIDS_precision_ciface, ONLY: & - ssids_inform_type, & - ssids_control_type, & - copy_ssids_inform_out => copy_inform_out, & - copy_ssids_control_in => copy_control_in + USE GALAHAD_SLBLT_precision_ciface, ONLY: & + slblt_inform_type, & + slblt_control_type, & + copy_slblt_inform_out => copy_inform_out, & + copy_slblt_control_in => copy_control_in USE GALAHAD_NODEND_precision_ciface, ONLY: & nodend_inform_type, & @@ -244,7 +244,7 @@ MODULE GALAHAD_SLS_precision_ciface TYPE ( ma86_info ) :: ma86_info TYPE ( ma87_info ) :: ma87_info TYPE ( ma97_info ) :: ma97_info - TYPE ( ssids_inform_type ) :: ssids_inform + TYPE ( slblt_inform_type ) :: slblt_inform TYPE ( nodend_inform_type ) :: nodend_inform INTEGER ( KIND = ipc_ ), DIMENSION( 10 ) :: mc61_info REAL ( KIND = rpc_ ), DIMENSION( 15 ) :: mc61_rinfo @@ -631,7 +631,7 @@ SUBROUTINE copy_inform_in( cinform, finform ) CALL copy_sils_ainfo_in( cinform%sils_ainfo, finform%sils_ainfo ) CALL copy_sils_finfo_in( cinform%sils_finfo, finform%sils_finfo ) CALL copy_sils_sinfo_in( cinform%sils_sinfo, finform%sils_sinfo ) -! CALL copy_ssids_inform_in( cinform%ssids_inform, finform%ssids_inform ) +! CALL copy_slblt_inform_in( cinform%slblt_inform, finform%slblt_inform ) CALL copy_nodend_inform_in( cinform%nodend_inform, & finform%nodend_inform ) @@ -735,7 +735,7 @@ SUBROUTINE copy_inform_out( finform, cinform ) CALL copy_ma87_info_out( finform%ma87_info, cinform%ma87_info ) CALL copy_ma97_info_out( finform%ma97_info, cinform%ma97_info ) CALL copy_nodend_inform_out( finform%nodend_inform, cinform%nodend_inform ) - CALL copy_ssids_inform_out( finform%ssids_inform, cinform%ssids_inform ) + CALL copy_slblt_inform_out( finform%slblt_inform, cinform%slblt_inform ) CALL copy_mc64_info_out( finform%mc64_info, cinform%mc64_info ) CALL copy_mc68_info_out( finform%mc68_info, cinform%mc68_info ) ! Strings diff --git a/src/sls/C/slst.c b/src/sls/C/slst.c index 24759803f9..1ac1d5d07f 100644 --- a/src/sls/C/slst.c +++ b/src/sls/C/slst.c @@ -42,7 +42,7 @@ int main(void) { printf(" basic tests of storage formats\n\n"); //char solver[] = "sytr"; //char solver[] = "ma57"; - char solver[] = "ssids"; + char solver[] = "slblt"; printf(" solver %s\n", solver); printf(" storage RHS refine partial\n"); diff --git a/src/sls/C/slstf.c b/src/sls/C/slstf.c index 99782ed97b..254ccc70a2 100644 --- a/src/sls/C/slstf.c +++ b/src/sls/C/slstf.c @@ -42,7 +42,7 @@ int main(void) { printf(" basic tests of storage formats\n\n"); //char solver[] = "sytr"; //char solver[] = "ma57"; - char solver[] = "ssids"; + char solver[] = "slblt"; printf(" solver %s\n", solver); printf(" storage RHS refine partial\n"); diff --git a/src/sls/Python/sls_pyiface.c b/src/sls/Python/sls_pyiface.c index 2556273393..67e0bc08d8 100644 --- a/src/sls/Python/sls_pyiface.c +++ b/src/sls/Python/sls_pyiface.c @@ -1,7 +1,7 @@ //* \file sls_pyiface.c */ /* - * THIS VERSION: GALAHAD 5.2 - 2025-03-26 AT 13:50 GMT. + * THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 13:50 GMT. * *-*-*-*-*-*-*-*-*- GALAHAD_SLS PYTHON INTERFACE *-*-*-*-*-*-*-*-*-*- * @@ -33,7 +33,7 @@ PyObject* nodend_make_inform_dict(const struct nodend_inform_type *inform); //PyObject* ma86_make_inform_dict(const struct ma86_inform_type *inform); //PyObject* ma87_make_inform_dict(const struct ma87_inform_type *inform); //PyObject* ma97_make_inform_dict(const struct ma97_inform_type *inform); -//PyObject* ssids_make_inform_dict(const struct ssids_inform_type *inform); +//PyObject* slblt_make_inform_dict(const struct slblt_inform_type *inform); //PyObject* mc64_make_inform_dict(const struct mc64_inform_type *inform); //PyObject* mc68_make_inform_dict(const struct mc68_inform_type *inform); @@ -658,8 +658,8 @@ PyObject* sls_make_inform_dict(const struct sls_inform_type *inform){ // ma87_make_inform_dict(&inform->ma87_inform)); //PyDict_SetItemString(py_inform, "ma97_inform", // ma97_make_inform_dict(&inform->ma97_inform)); - //PyDict_SetItemString(py_inform, "ssids_inform", - // ssids_make_inform_dict(&inform->ssids_inform)); + //PyDict_SetItemString(py_inform, "slblt_inform", + // slblt_make_inform_dict(&inform->slblt_inform)); //PyDict_SetItemString(py_inform, "mc61_info", // PyLong_FromLong(inform->mc61_info)); //PyDict_SetItemString(py_inform, "mc61_rinfo", @@ -991,11 +991,11 @@ PyDoc_STRVAR(sls_module_doc, "\n" "The method provides a common interface to a variety of well-known solvers \n" "from HSL and elsewhere. Currently supported solvers include MA27/SILS, \n" -"HSL_MA57, HSL_MA77 , HSL_MA86, HSL_MA87 and HSL_MA97 from HSL, SSIDS \n" -"from SPRAL, MUMPS from Mumps Technologies, PARDISO both from the \n" +"HSL_MA57, HSL_MA77 , HSL_MA86, HSL_MA87 and HSL_MA97 from HSL, SLBLT, \n" +"MUMPS from Mumps Technologies, PARDISO both from the \n" "Pardiso Project and Intel’s MKL, PaStiX from Inria, and WSMP from the \n" "IBM alpha Works, as well as POTR, SYTR and SBTR from LAPACK. Note\n" -"that, with the exception of SSIDS and the Netlib reference LAPACK codes, \n" +"that, with the exception of SLBLT and the Netlib reference LAPACK codes, \n" "the solvers themselves do not form part of this package and must be \n" "obtained/linked to separately. Dummy instances are provided for solvers \n" "that are unavailable. Also note that additional flexibility may be \n" diff --git a/src/sls/RUNSLS.meta b/src/sls/RUNSLS.meta index e72bbd7ddf..2283dd4493 100644 --- a/src/sls/RUNSLS.meta +++ b/src/sls/RUNSLS.meta @@ -9,7 +9,7 @@ MAIN ! write-result-summary no ! result-summary-file-name SLSRES.d ! result-summary-file-device 47 -! symmetric-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt ! kkt-system yes ! barrier-perturbation 1.0 ! solution-passes 1 diff --git a/src/sls/sls.F90 b/src/sls/sls.F90 index 055aca5c9b..b93a7ed72e 100644 --- a/src/sls/sls.F90 +++ b/src/sls/sls.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.4 - 2025-10-05 AT 15:10 GMT +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 15:10 GMT #include "galahad_modules.h" #undef METIS_DBG_INFO @@ -32,7 +32,7 @@ MODULE GALAHAD_SLS_precision ! | MA86 | ! | MA87 | ! | MA97 | -! | SSIDS from SPRAL | +! | SLBLT from GALAHAD | ! | MUMPS | ! | PARDISO | ! | MKL PARDISO | @@ -68,7 +68,7 @@ MODULE GALAHAD_SLS_precision USE hsl_mc64_precision USE hsl_mc68_integer USE MKL_PARDISO - USE GALAHAD_SSIDS_precision + USE GALAHAD_SLBLT_precision USE GALAHAD_MUMPS_TYPES_precision, MPI_COMM_WORLD_mumps => MPI_COMM_WORLD USE galahad_spmf_enums, MPI_COMM_WORLD_pastix => MPI_COMM_WORLD USE galahad_spmf_interfaces @@ -82,7 +82,7 @@ MODULE GALAHAD_SLS_precision PUBLIC :: SLS_initialize, SLS_analyse, SLS_factorize, SLS_solve, & SLS_fredholm_alternative, SLS_terminate, SLS_enquire, & SLS_alter_d, SLS_part_solve, SLS_sparse_forward_solve, & - SLS_read_specfile, SLS_available, SLS_ssids_available, & + SLS_read_specfile, SLS_available, SLS_slblt_available, & SLS_sils_available, SLS_ma57_available, SLS_ma77_available, & SLS_ma86_available, SLS_ma87_available, SLS_ma97_available, & SLS_mumps_available, SLS_pardiso_available, & @@ -688,9 +688,9 @@ MODULE GALAHAD_SLS_precision TYPE ( MA97_info ) :: ma97_info -! the output structure from ssids +! the output structure from slblt - TYPE ( SSIDS_inform_type ) :: ssids_inform + TYPE ( SLBLT_inform_type ) :: slblt_inform ! the output structure from nodend @@ -775,7 +775,6 @@ MODULE GALAHAD_SLS_precision LOGICAL :: no_pastix = .FALSE. LOGICAL :: no_sils = .FALSE. LOGICAL :: no_ma57 = .FALSE. - LOGICAL :: no_ssids = .FALSE. LOGICAL :: trivial_matrix_type = .FALSE. INTEGER ( KIND = long_ ), DIMENSION( 64 ) :: pardiso_PT TYPE ( MKL_PARDISO_HANDLE ), DIMENSION( 64 ) :: mkl_pardiso_PT @@ -849,10 +848,10 @@ MODULE GALAHAD_SLS_precision TYPE ( MA97_control ) :: ma97_control TYPE ( MA97_info ) :: ma97_info - TYPE ( SSIDS_akeep_type ) :: ssids_akeep - TYPE ( SSIDS_fkeep_type ) :: ssids_fkeep - TYPE ( SSIDS_control_type ) :: ssids_control - TYPE ( SSIDS_inform_type ) :: ssids_inform + TYPE ( SLBLT_akeep_type ) :: slblt_akeep + TYPE ( SLBLT_fkeep_type ) :: slblt_fkeep + TYPE ( SLBLT_control_type ) :: slblt_control + TYPE ( SLBLT_inform_type ) :: slblt_inform TYPE ( AMD_data_type ) :: amd_data TYPE ( AMD_control_type ) :: amd_control @@ -1022,10 +1021,10 @@ SUBROUTINE SLS_available( solver, available, enquire, perm, pivots, d, & IF ( PRESENT( sparse_forward_solve ) ) sparse_forward_solve = .TRUE. IF ( PRESENT( fredholm_alternative ) ) fredholm_alternative = .TRUE. -! = SSIDS = +! = SLBLT = - CASE ( 'ssids' ) - IF ( PRESENT( available ) ) available = SLS_ssids_available( ) + CASE ( 'slblt' ) + IF ( PRESENT( available ) ) available = SLS_slblt_available( ) IF ( PRESENT( enquire ) ) enquire = .TRUE. IF ( PRESENT( perm ) ) perm = .TRUE. IF ( PRESENT( pivots ) ) pivots = .TRUE. @@ -1208,11 +1207,11 @@ LOGICAL FUNCTION SLS_ma97_available( ) SLS_ma97_available = ma97_available END FUNCTION SLS_ma97_available -! - G A L A H A D - S L S _ S S I D S _ A V A I L A B L E F U N C T ION - +! - G A L A H A D - S L S _ S L B L T _ A V A I L A B L E F U N C T ION - - LOGICAL FUNCTION SLS_ssids_available( ) - SLS_ssids_available = ssids_available - END FUNCTION SLS_ssids_available + LOGICAL FUNCTION SLS_slblt_available( ) + SLS_slblt_available = .TRUE. + END FUNCTION SLS_slblt_available ! - G A L A H A D - S L S _ M U M P S _ A V A I L A B L E F U N C T ION - @@ -1493,11 +1492,11 @@ SUBROUTINE SLS_initialize( solver, data, control, inform, check ) ! END IF END IF -! = SSIDS = +! = SLBLT = - CASE ( 'ssids' ) + CASE ( 'slblt' ) IF ( control%scaling == 0 ) & - control%scaling = - data%ssids_control%scaling + control%scaling = - data%slblt_control%scaling ! control%node_amalgamation = 8 IF ( control%ordering == 0 ) THEN control%ordering = 3 @@ -1613,12 +1612,10 @@ SUBROUTINE SLS_initialize_solver( solver, data, error, inform, check ) ! local variables - INTEGER ( KIND = ip_ ) :: flag_ssids LOGICAL :: check_available, mpi_initialzed_flag INTEGER ( KIND = ip_ ), DIMENSION( 30 ) :: ICNTL_ma27 REAL ( KIND = rp_ ), DIMENSION( 5 ) :: CNTL_ma27 TYPE ( MA57_control ) :: control_ma57 - TYPE ( SSIDS_akeep_type ) :: akeep_ssids !$ LOGICAL :: OMP_GET_CANCELLATION !$ INTEGER ( KIND = ip_ ) :: OMP_GET_PROC_BIND !$ INTEGER :: omp_status @@ -1639,7 +1636,7 @@ SUBROUTINE SLS_initialize_solver( solver, data, error, inform, check ) ! ensure that OpenMP has been correctly initialized !$ SELECT CASE( data%solver( 1 : data%len_solver ) ) -!$ CASE ( 'ssids', 'mumps' ) +!$ CASE ( 'slblt', 'mumps' ) !$ CALL get_environment_variable( "OMP_CANCELLATION", STATUS = omp_status ) !$ IF ( omp_status == 0 ) THEN !$ CALL get_environment_variable( "OMP_PROC_BIND", STATUS = omp_status ) @@ -1669,10 +1666,10 @@ SUBROUTINE SLS_initialize_solver( solver, data, error, inform, check ) CALL MA27I( ICNTL_ma27, CNTL_ma27 ) data%no_sils = ICNTL_ma27( 4 ) == - 1 IF ( data%no_sils ) THEN - IF ( check_available ) THEN ! if sils is unavailble, use ssids instead + IF ( check_available ) THEN ! if sils is unavailble, use slblt instead data%solver = REPEAT( ' ', len_solver ) data%len_solver = 5 - data%solver( 1 : data%len_solver ) = 'ssids' + data%solver( 1 : data%len_solver ) = 'slblt' GO TO 10 ELSE inform%status = GALAHAD_unavailable_option ; RETURN @@ -1721,21 +1718,9 @@ SUBROUTINE SLS_initialize_solver( solver, data, error, inform, check ) CASE ( 'ma97' ) data%must_be_definite = .FALSE. -! = SSIDS = +! = SLBLT = - CASE ( 'ssids' ) - CALL SSIDS_free( akeep_ssids, flag_ssids ) - data%no_ssids = flag_ssids == GALAHAD_unavailable_option - IF ( data%no_ssids ) THEN - IF ( check_available ) THEN ! if ssids is unavailble, use sytr instead - data%solver = REPEAT( ' ', len_solver ) - data%len_solver = 4 - data%solver( 1 : data%len_solver ) = 'sytr' - GO TO 10 - ELSE - inform%status = GALAHAD_unavailable_option ; RETURN - END IF - END IF + CASE ( 'slblt' ) data%must_be_definite = .FALSE. ! = PARDISO = @@ -2174,63 +2159,63 @@ SUBROUTINE SLS_copy_control_to_ma97( control, control_ma97 ) END SUBROUTINE SLS_copy_control_to_ma97 -!- S L S _ C O P Y _ C O N T R O L _ T O _ S S I D S S U B R O U T I N E - +!- S L S _ C O P Y _ C O N T R O L _ T O _ S L B L T S U B R O U T I N E - - SUBROUTINE SLS_copy_control_to_ssids( control, control_ssids ) + SUBROUTINE SLS_copy_control_to_slblt( control, control_slblt ) -! copy control parameters to their SSIDS equivalents +! copy control parameters to their SLBLT equivalents ! Dummy arguments TYPE ( SLS_control_type ), INTENT( IN ) :: control - TYPE ( SSIDS_control_type ), INTENT( INOUT ) :: control_ssids + TYPE ( SLBLT_control_type ), INTENT( INOUT ) :: control_slblt IF ( control%print_level_solver > 0 ) THEN - control_ssids%unit_error = control%error - control_ssids%unit_warning = control%warning - control_ssids%unit_diagnostics = control%out + control_slblt%unit_error = control%error + control_slblt%unit_warning = control%warning + control_slblt%unit_diagnostics = control%out ELSE - control_ssids%unit_error = - 1 - control_ssids%unit_warning = - 1 - control_ssids%unit_diagnostics = - 1 + control_slblt%unit_error = - 1 + control_slblt%unit_warning = - 1 + control_slblt%unit_diagnostics = - 1 END IF - control_ssids%print_level = control%print_level_solver - control_ssids%nemin = control%node_amalgamation + control_slblt%print_level = control%print_level_solver + control_slblt%nemin = control%node_amalgamation IF ( control%scaling == - 1 ) THEN - control_ssids%scaling = 1 + control_slblt%scaling = 1 ELSE IF ( control%scaling == - 2 ) THEN - control_ssids%scaling = 2 + control_slblt%scaling = 2 ELSE IF ( control%scaling == - 3 ) THEN - control_ssids%scaling = 3 + control_slblt%scaling = 3 ELSE - control_ssids%scaling = 0 + control_slblt%scaling = 0 END IF - control_ssids%small = control%absolute_pivot_tolerance -! control_ssids%presolve = 0 -! control_ssids%consist_tol = control%consistency_tolerance + control_slblt%small = control%absolute_pivot_tolerance +! control_slblt%presolve = 0 +! control_slblt%consist_tol = control%consistency_tolerance IF ( control%pivot_control == 2 ) THEN - control_ssids%u = 0.0_rp_ -! control_ssids%presolve = 1 - control_ssids%action = .TRUE. + control_slblt%u = 0.0_rp_ +! control_slblt%presolve = 1 + control_slblt%action = .TRUE. ELSE IF ( control%pivot_control == 3 ) THEN - control_ssids%u = 0.0_rp_ -! control_ssids%action = .TRUE. -! control_ssids%presolve = 1 - control_ssids%action = .FALSE. + control_slblt%u = 0.0_rp_ +! control_slblt%action = .TRUE. +! control_slblt%presolve = 1 + control_slblt%action = .FALSE. ELSE IF ( control%pivot_control == 4 ) THEN - control_ssids%u = 0.0_rp_ - control_ssids%action = .TRUE. + control_slblt%u = 0.0_rp_ + control_slblt%action = .TRUE. ELSE - control_ssids%u = control%relative_pivot_tolerance - control_ssids%action = .TRUE. + control_slblt%u = control%relative_pivot_tolerance + control_slblt%action = .TRUE. END IF -! IF ( control%multiple_rhs ) control_ssids%presolve = 1 +! IF ( control%multiple_rhs ) control_slblt%presolve = 1 RETURN -! End of SLS_copy_control_to_ssids +! End of SLS_copy_control_to_slblt - END SUBROUTINE SLS_copy_control_to_ssids + END SUBROUTINE SLS_copy_control_to_slblt !- S L S _ C O P Y _ C O N T R O L _ T O _ P A R D I S O S U B R O U T I N E - @@ -2617,36 +2602,36 @@ SUBROUTINE SLS_copy_inform_from_ma97( inform, info_ma97 ) END SUBROUTINE SLS_copy_inform_from_ma97 -!- S L S _ C O P Y _ I N F O R M _ F R O M _ S S I D S S U B R O U T I N E - +!- S L S _ C O P Y _ I N F O R M _ F R O M _ S L B L T S U B R O U T I N E - - SUBROUTINE SLS_copy_inform_from_ssids( inform, ssids_inform ) + SUBROUTINE SLS_copy_inform_from_slblt( inform, slblt_inform ) -! copy inform parameters from their SSIDS equivalents +! copy inform parameters from their SLBLT equivalents ! Dummy arguments TYPE ( SLS_inform_type ), INTENT( INOUT ) :: inform - TYPE ( SSIDS_inform_type ), INTENT( IN ) :: ssids_inform + TYPE ( SLBLT_inform_type ), INTENT( IN ) :: slblt_inform - inform%ssids_inform = ssids_inform - inform%status = ssids_inform%flag + inform%slblt_inform = slblt_inform + inform%status = slblt_inform%flag SELECT CASE( inform%status ) CASE ( 0 : ) inform%status = GALAHAD_ok - inform%duplicates = ssids_inform%matrix_dup - inform%out_of_range = ssids_inform%matrix_outrange - inform%two_by_two_pivots = ssids_inform%num_two - inform%rank = ssids_inform%matrix_rank - inform%negative_eigenvalues = ssids_inform%num_neg -! inform%static_pivots = ssids_inform%num_perturbed - inform%delayed_pivots = ssids_inform%num_delay - inform%entries_in_factors = ssids_inform%num_factor - inform%flops_elimination = ssids_inform%num_flops - inform%max_front_size = ssids_inform%maxfront - inform%max_depth_assembly_tree = ssids_inform%maxdepth + inform%duplicates = slblt_inform%matrix_dup + inform%out_of_range = slblt_inform%matrix_outrange + inform%two_by_two_pivots = slblt_inform%num_two + inform%rank = slblt_inform%matrix_rank + inform%negative_eigenvalues = slblt_inform%num_neg +! inform%static_pivots = slblt_inform%num_perturbed + inform%delayed_pivots = slblt_inform%num_delay + inform%entries_in_factors = slblt_inform%num_factor + inform%flops_elimination = slblt_inform%num_flops + inform%max_front_size = slblt_inform%maxfront + inform%max_depth_assembly_tree = slblt_inform%maxdepth CASE ( - 50 ) inform%status = GALAHAD_error_allocate - inform%alloc_status = ssids_inform%stat + inform%alloc_status = slblt_inform%stat CASE( - 1, - 2, - 3, - 4, - 7, - 10, - 11, - 12, - 13, - 14 ) inform%status = GALAHAD_error_restrictions CASE ( - 8, - 9, - 15 ) @@ -2663,9 +2648,9 @@ SUBROUTINE SLS_copy_inform_from_ssids( inform, ssids_inform ) RETURN -! End of SLS_copy_inform_from_ssids +! End of SLS_copy_inform_from_slblt - END SUBROUTINE SLS_copy_inform_from_ssids + END SUBROUTINE SLS_copy_inform_from_slblt !-*-*-*-*- S L S _ R E A D _ S P E C F I L E S U B R O U T I N E -*-*-*-*- @@ -3165,14 +3150,6 @@ SUBROUTINE SLS_analyse( matrix, data, control, inform, PERM ) GO TO 900 END IF -! = SSIDS = - - CASE ( 'ssids' ) - IF ( data%no_ssids ) THEN - inform%status = GALAHAD_error_unknown_solver - GO TO 900 - END IF - ! = PaStiX = CASE ( 'pastix' ) @@ -3238,7 +3215,7 @@ SUBROUTINE SLS_analyse( matrix, data, control, inform, PERM ) ! decide if the ordering should be chosen by one of mc61, mc68 or amd SELECT CASE( data%solver( 1 : data%len_solver ) ) - CASE ( 'ma77', 'ma86', 'ma87', 'ma97', 'ssids' ) + CASE ( 'ma77', 'ma86', 'ma87', 'ma97', 'slblt' ) mc6168_ordering = control%ordering >= 0 .AND. .NOT. PRESENT( PERM ) CASE DEFAULT mc6168_ordering = control%ordering > 0 .AND. .NOT. PRESENT( PERM ) @@ -3874,9 +3851,9 @@ SUBROUTINE SLS_analyse( matrix, data, control, inform, PERM ) data%ma77_control, data%ma77_info ) CALL SLS_copy_inform_from_ma77( inform, data%ma77_info ) -! = MA86, MA87, MA97, SSIDS, PARDISO or WSMP = +! = MA86, MA87, MA97, SLBLT, PARDISO or WSMP = - CASE ( 'ma86', 'ma87', 'ma97', 'ssids', 'pardiso', 'mkl_pardiso', & + CASE ( 'ma86', 'ma87', 'ma97', 'slblt', 'pardiso', 'mkl_pardiso', & 'wsmp', 'pastix' ) ! convert the data to sorted compressed-sparse row format @@ -4141,36 +4118,36 @@ SUBROUTINE SLS_analyse( matrix, data, control, inform, PERM ) data%LFLAG( i ) = .FALSE. END DO -! = SSIDS = +! = SLBLT = - CASE ( 'ssids' ) - CALL SLS_copy_control_to_ssids( control, data%ssids_control ) + CASE ( 'slblt' ) + CALL SLS_copy_control_to_slblt( control, data%slblt_control ) CALL CPU_time( time ) ; CALL CLOCK_time( clock ) IF ( mc6168_ordering ) THEN - data%ssids_control%ordering = 0 - CALL SSIDS_analyse( .FALSE., data%matrix%n, & + data%slblt_control%ordering = 0 + CALL SLBLT_analyse( .FALSE., data%matrix%n, & data%matrix%PTR, data%matrix%COL, & - data%ssids_akeep, & - data%ssids_control, data%ssids_inform, & + data%slblt_akeep, & + data%slblt_control, data%slblt_inform, & order = data%ORDER ) ELSE IF ( PRESENT( PERM ) ) THEN - data%ssids_control%ordering = 0 - CALL SSIDS_analyse( .FALSE., data%matrix%n, & + data%slblt_control%ordering = 0 + CALL SLBLT_analyse( .FALSE., data%matrix%n, & data%matrix%PTR, data%matrix%COL, & - data%ssids_akeep, & - data%ssids_control, data%ssids_inform, & + data%slblt_akeep, & + data%slblt_control, data%slblt_inform, & order = data%ORDER ) ELSE - data%ssids_control%ordering = - control%ordering - CALL SSIDS_analyse( .FALSE., data%matrix%n, & + data%slblt_control%ordering = - control%ordering + CALL SLBLT_analyse( .FALSE., data%matrix%n, & data%matrix%PTR, data%matrix%COL, & - data%ssids_akeep, & - data%ssids_control, data%ssids_inform, & + data%slblt_akeep, & + data%slblt_control, data%slblt_inform, & order = data%ORDER ) END IF END IF - CALL SLS_copy_inform_from_ssids( inform, data%ssids_inform ) + CALL SLS_copy_inform_from_slblt( inform, data%slblt_inform ) IF ( inform%status /= GALAHAD_ok ) GO TO 800 CALL SPACE_resize_array( matrix%n, data%LFLAG, & inform%status, inform%alloc_status ) @@ -5357,9 +5334,9 @@ SUBROUTINE SLS_factorize( matrix, data, control, inform ) path = path ) END IF -! = MA86, MA87, MA97, SSIDS, PARDISO or WSMP = +! = MA86, MA87, MA97, SLBLT, PARDISO or WSMP = - CASE ( 'ma86', 'ma87', 'ma97', 'ssids', 'pardiso', 'mkl_pardiso', & + CASE ( 'ma86', 'ma87', 'ma97', 'slblt', 'pardiso', 'mkl_pardiso', & 'wsmp', 'pastix' ) data%matrix%n = matrix%n DO i = 1, matrix%n @@ -5526,10 +5503,10 @@ SUBROUTINE SLS_factorize( matrix, data, control, inform ) END IF CALL SLS_copy_inform_from_ma97( inform, data%ma97_info ) -! = SSIDS = +! = SLBLT = - CASE ( 'ssids' ) - CALL SLS_copy_control_to_ssids( control, data%ssids_control ) + CASE ( 'slblt' ) + CALL SLS_copy_control_to_slblt( control, data%slblt_control ) CALL CPU_time( time ) ; CALL CLOCK_time( clock ) ! WRITE( 77, * ) data%matrix%n ! WRITE( 77, * ) data%matrix%PTR( : data%matrix%n + 1 ) @@ -5537,23 +5514,23 @@ SUBROUTINE SLS_factorize( matrix, data, control, inform ) ! WRITE( 77, * ) data%matrix%VAL( : data%matrix%PTR( data%matrix%n + 1 ) ) ! stop must_be_definite = data%must_be_definite - IF ( data%ssids_control%scaling == 0 ) THEN - CALL SSIDS_factor( must_be_definite, data%matrix%VAL, & - data%ssids_akeep, data%ssids_fkeep, & - data%ssids_control, data%ssids_inform, & + IF ( data%slblt_control%scaling == 0 ) THEN + CALL SLBLT_factor( must_be_definite, data%matrix%VAL, & + data%slblt_akeep, data%slblt_fkeep, & + data%slblt_control, data%slblt_inform, & ptr = data%matrix%PTR, row = data%matrix%COL ) ELSE CALL SPACE_resize_array( data%n, data%SCALE, & inform%status, inform%alloc_status ) IF ( inform%status /= GALAHAD_ok ) THEN inform%bad_alloc = 'sls: data%matrix%VAL' ; GO TO 800 ; END IF - CALL SSIDS_factor( must_be_definite, data%matrix%VAL, & - data%ssids_akeep, data%ssids_fkeep, & - data%ssids_control, data%ssids_inform, & + CALL SLBLT_factor( must_be_definite, data%matrix%VAL, & + data%slblt_akeep, data%slblt_fkeep, & + data%slblt_control, data%slblt_inform, & scale = data%SCALE, & ptr = data%matrix%PTR, row = data%matrix%COL ) END IF - CALL SLS_copy_inform_from_ssids( inform, data%ssids_inform ) + CALL SLS_copy_inform_from_slblt( inform, data%slblt_inform ) ! = PARDISO = @@ -6874,14 +6851,14 @@ SUBROUTINE SLS_solve_one_rhs( matrix, X, data, control, inform ) data%ma97_control, data%ma97_info ) CALL SLS_copy_inform_from_ma97( inform, data%ma97_info ) -! = SSIDS = +! = SLBLT = - CASE ( 'ssids' ) - CALL SLS_copy_control_to_ssids( control, data%ssids_control ) + CASE ( 'slblt' ) + CALL SLS_copy_control_to_slblt( control, data%slblt_control ) CALL CPU_time( time ) ; CALL CLOCK_time( clock ) - CALL SSIDS_solve( X( : data%n ), data%ssids_akeep, data%ssids_fkeep, & - data%ssids_control, data%ssids_inform ) - CALL SLS_copy_inform_from_ssids( inform, data%ssids_inform ) + CALL SLBLT_solve( X( : data%n ), data%slblt_akeep, data%slblt_fkeep, & + data%slblt_control, data%slblt_inform ) + CALL SLS_copy_inform_from_slblt( inform, data%slblt_inform ) ! = PARDISO = @@ -7291,16 +7268,16 @@ SUBROUTINE SLS_solve_multiple_rhs( matrix, X, data, control, inform ) data%ma97_control, data%ma97_info ) CALL SLS_copy_inform_from_ma97( inform, data%ma97_info ) -! = SSIDS = +! = SLBLT = - CASE ( 'ssids' ) + CASE ( 'slblt' ) inform%status = GALAHAD_unavailable_option lx = SIZE( X, 1 ) ; nrhs = SIZE( X, 2 ) - CALL SLS_copy_control_to_ssids( control, data%ssids_control ) + CALL SLS_copy_control_to_slblt( control, data%slblt_control ) CALL CPU_time( time ) ; CALL CLOCK_time( clock ) - CALL SSIDS_solve( nrhs, X, lx, data%ssids_akeep, data%ssids_fkeep, & - data%ssids_control, data%ssids_inform ) - CALL SLS_copy_inform_from_ssids( inform, data%ssids_inform ) + CALL SLBLT_solve( nrhs, X, lx, data%slblt_akeep, data%slblt_fkeep, & + data%slblt_control, data%slblt_inform ) + CALL SLS_copy_inform_from_slblt( inform, data%slblt_inform ) ! = PARDISO = @@ -7708,11 +7685,11 @@ SUBROUTINE SLS_terminate( data, control, inform ) CALL MA97_finalise( data%ma97_akeep, data%ma97_fkeep ) inform%status = 0 -! = SSIDS = +! = SLBLT = - CASE ( 'ssids' ) + CASE ( 'slblt' ) CALL SPACE_dealloc_array( data%X2, inform%status, inform%alloc_status ) - CALL SSIDS_free( data%ssids_akeep, data%ssids_fkeep, inform%status ) + CALL SLBLT_free( data%slblt_akeep, data%slblt_fkeep, inform%status ) inform%status = 0 ! = PARDISO = @@ -8128,15 +8105,15 @@ SUBROUTINE SLS_enquire( data, inform, PERM, PIVOTS, D, PERTURBATION ) END IF END IF -! = SSIDS = +! = SLBLT = - CASE ( 'ssids' ) + CASE ( 'slblt' ) IF ( PRESENT( PERM ) ) PERM = data%ORDER( : data%n ) IF ( PRESENT( PERTURBATION ) ) inform%status = GALAHAD_error_access_pert IF ( data%must_be_definite ) THEN IF ( PRESENT( PIVOTS ) ) inform%status = GALAHAD_error_access_pivots - CALL SSIDS_enquire_posdef( data%ssids_akeep, data%ssids_fkeep, & - data%ssids_control, data%ssids_inform, & + CALL SLBLT_enquire_posdef( data%slblt_akeep, data%slblt_fkeep, & + data%slblt_control, data%slblt_inform, & D( 1, : ) ) D( 2, : ) = 0.0_rp_ ELSE @@ -8149,18 +8126,18 @@ SUBROUTINE SLS_enquire( data, inform, PERM, PIVOTS, D, PERTURBATION ) END IF IF ( PRESENT( D ) ) THEN IF ( PRESENT( PIVOTS ) ) THEN - CALL SSIDS_enquire_indef( data%ssids_akeep, data%ssids_fkeep, & - data%ssids_control, data%ssids_inform, & + CALL SLBLT_enquire_indef( data%slblt_akeep, data%slblt_fkeep, & + data%slblt_control, data%slblt_inform, & piv_order = data%INVP, d = D ) ELSE - CALL SSIDS_enquire_indef( data%ssids_akeep, data%ssids_fkeep, & - data%ssids_control, data%ssids_inform, & + CALL SLBLT_enquire_indef( data%slblt_akeep, data%slblt_fkeep, & + data%slblt_control, data%slblt_inform, & d = D ) END IF ELSE IF ( PRESENT( PIVOTS ) ) THEN - CALL SSIDS_enquire_indef( data%ssids_akeep, data%ssids_fkeep, & - data%ssids_control, data%ssids_inform, & + CALL SLBLT_enquire_indef( data%slblt_akeep, data%slblt_fkeep, & + data%slblt_control, data%slblt_inform, & piv_order = data%INVP ) END IF END IF @@ -8382,15 +8359,15 @@ SUBROUTINE SLS_alter_d( data, D, inform ) CALL SLS_copy_inform_from_ma97( inform, data%ma97_info ) END IF -! = SSIDS = +! = SLBLT = - CASE ( 'ssids' ) + CASE ( 'slblt' ) IF ( data%must_be_definite ) THEN inform%status = GALAHAD_ok ELSE - CALL SSIDS_alter( D, data%ssids_akeep, data%ssids_fkeep, & - data%ssids_control, data%ssids_inform ) - CALL SLS_copy_inform_from_ssids( inform, data%ssids_inform ) + CALL SLBLT_alter( D, data%slblt_akeep, data%slblt_fkeep, & + data%slblt_control, data%slblt_inform ) + CALL SLS_copy_inform_from_slblt( inform, data%slblt_inform ) END IF ! = POTR = @@ -8814,39 +8791,39 @@ SUBROUTINE SLS_part_solve( part, X, data, control, inform ) END IF CALL SLS_copy_inform_from_ma97( inform, data%ma97_info ) -! = SSIDS = +! = SLBLT = - CASE ( 'ssids' ) + CASE ( 'slblt' ) ! inform%status = GALAHAD_unavailable_option ! GO TO 900 CALL CPU_time( time ) ; CALL CLOCK_time( clock ) IF ( part == 'L' .OR. ( part == 'S' .AND. data%must_be_definite ) ) THEN - CALL SSIDS_solve( X( : data%n ), data%ssids_akeep, data%ssids_fkeep, & - data%ssids_control, data%ssids_inform, job = 1_ip_ ) + CALL SLBLT_solve( X( : data%n ), data%slblt_akeep, data%slblt_fkeep, & + data%slblt_control, data%slblt_inform, job = 1_ip_ ) ELSE IF ( part == 'D' ) THEN IF ( data%must_be_definite ) THEN inform%status = 0 GO TO 900 ELSE - CALL SSIDS_solve( X( : data%n ), data%ssids_akeep, data%ssids_fkeep,& - data%ssids_control, data%ssids_inform, job = 2_ip_ ) + CALL SLBLT_solve( X( : data%n ), data%slblt_akeep, data%slblt_fkeep,& + data%slblt_control, data%slblt_inform, job = 2_ip_ ) END IF ELSE IF ( part == 'U' ) THEN - CALL SSIDS_solve( X( : data%n ), data%ssids_akeep, data%ssids_fkeep, & - data%ssids_control, data%ssids_inform, job = 3_ip_ ) + CALL SLBLT_solve( X( : data%n ), data%slblt_akeep, data%slblt_fkeep, & + data%slblt_control, data%slblt_inform, job = 3_ip_ ) ELSE - CALL SSIDS_solve( X( : data%n ), data%ssids_akeep, data%ssids_fkeep, & - data%ssids_control, data%ssids_inform, job = 1_ip_ ) - CALL SLS_copy_inform_from_ssids( inform, data%ssids_inform ) + CALL SLBLT_solve( X( : data%n ), data%slblt_akeep, data%slblt_fkeep, & + data%slblt_control, data%slblt_inform, job = 1_ip_ ) + CALL SLS_copy_inform_from_slblt( inform, data%slblt_inform ) IF ( inform%status /= GALAHAD_ok ) GO TO 900 CALL SPACE_resize_array( data%n, data%WORK, & inform%status, inform%alloc_status ) IF ( inform%status /= GALAHAD_ok ) GO TO 900 data%WORK( : data%n ) = X( : data%n ) - CALL SSIDS_solve( data%WORK( : data%n ), data%ssids_akeep, & - data%ssids_fkeep, & - data%ssids_control, data%ssids_inform, job = 2_ip_ ) - CALL SLS_copy_inform_from_ssids( inform, data%ssids_inform ) + CALL SLBLT_solve( data%WORK( : data%n ), data%slblt_akeep, & + data%slblt_fkeep, & + data%slblt_control, data%slblt_inform, job = 2_ip_ ) + CALL SLS_copy_inform_from_slblt( inform, data%slblt_inform ) IF ( inform%status /= GALAHAD_ok ) GO TO 900 DO i = 1, data%n IF ( X( i ) == 0.0_rp_ .AND. data%WORK( i ) == 0.0_rp_ ) CYCLE @@ -8865,7 +8842,7 @@ SUBROUTINE SLS_part_solve( part, X, data, control, inform ) END IF END DO END IF - CALL SLS_copy_inform_from_ssids( inform, data%ssids_inform ) + CALL SLS_copy_inform_from_slblt( inform, data%slblt_inform ) ! = PARDISO = @@ -9213,7 +9190,7 @@ SUBROUTINE SLS_sparse_forward_solve( nnz_b, INDEX_b, B, nnz_x, INDEX_x, & ! skip solvers that have sparse option - CASE ( 'ma57', 'ma87', 'ma97', 'ssids' ) + CASE ( 'ma57', 'ma87', 'ma97', 'slblt' ) ! those that don't @@ -9481,18 +9458,18 @@ SUBROUTINE SLS_sparse_forward_solve( nnz_b, INDEX_b, B, nnz_x, INDEX_x, & ! END IF CALL SLS_copy_inform_from_ma97( inform, data%ma97_info ) -! = SSIDS = +! = SLBLT = - CASE ( 'ssids' ) + CASE ( 'slblt' ) inform%status = GALAHAD_unavailable_option GO TO 900 ! CALL CPU_time( time ) ; CALL CLOCK_time( clock ) -! CALL SSIDS_sparse_fwd_solve( nnz_b, INDEX_b, B, data%ORDER, data%LFLAG, & +! CALL SLBLT_sparse_fwd_solve( nnz_b, INDEX_b, B, data%ORDER, data%LFLAG, & ! nnz_x, INDEX_x, X, & -! data%ssids_akeep, data%ssids_fkeep, & -! data%ssids_control, data%ssids_inform ) +! data%slblt_akeep, data%slblt_fkeep, & +! data%slblt_control, data%slblt_inform ) ! data%LFLAG( INDEX_x( : nnz_x ) ) = .FALSE. -! CALL SLS_copy_inform_from_ssids( inform, data%ssids_inform ) +! CALL SLS_copy_inform_from_slblt( inform, data%slblt_inform ) ! = PARDISO = @@ -9721,7 +9698,7 @@ SUBROUTINE SLS_sparse_forward_solve( nnz_b, INDEX_b, B, nnz_x, INDEX_x, & ! skip solvers that have sparse option - CASE ( 'ma57', 'ma87', 'ma97', 'ssids' ) + CASE ( 'ma57', 'ma87', 'ma97', 'slblt' ) ! those that don't @@ -9941,9 +9918,9 @@ SUBROUTINE SLS_fredholm_alternative( matrix, X, data, control, inform ) X( : data%n ) = data%X2( : data%n, 1 ) END IF -! = SSIDS = +! = SLBLT = - CASE ( 'ssids' ) + CASE ( 'slblt' ) inform%status = GALAHAD_unavailable_option GO TO 900 ! CALL SPACE_resize_array( data%n, 2_ip_, data%X2, inform%status, & @@ -9951,13 +9928,13 @@ SUBROUTINE SLS_fredholm_alternative( matrix, X, data, control, inform ) ! IF ( inform%status /= GALAHAD_ok ) THEN ! inform%bad_alloc = 'sls: data%X2' ; GO TO 900 ; END IF ! data%X2( : data%n, 1 ) = X( : data%n ) -! CALL SLS_copy_control_to_ssids( control, data%ssids_control ) +! CALL SLS_copy_control_to_slblt( control, data%slblt_control ) ! CALL CPU_time( time ) ; CALL CLOCK_time( clock ) -! CALL SSIDS_solve_fredholm( 1_ip_, flag_out, data%X2, data%n, & -! data%ssids_akeep, data%ssids_fkeep, & -! data%ssids_control, data%ssids_inform ) +! CALL SLBLT_solve_fredholm( 1_ip_, flag_out, data%X2, data%n, & +! data%slblt_akeep, data%slblt_fkeep, & +! data%slblt_control, data%slblt_inform ) ! inform%alternative = .NOT. flag_out( 1 ) -! CALL SLS_copy_inform_from_ssids( inform, data%ssids_inform ) +! CALL SLS_copy_inform_from_slblt( inform, data%slblt_inform ) ! IF ( inform%status /= GALAHAD_ok ) GO TO 800 ! IF ( inform%alternative ) THEN ! X( : data%n ) = data%X2( : data%n, 2 ) @@ -10594,7 +10571,7 @@ SUBROUTINE SLS_coord_to_sorted_csr( n, ne, row, col, map, ptr, dup, oor, & alloc_status ) ! Compute a mapping from the co-ordinate scheme to the row storage scheme -! used by MA86, MA87, MA97, SSIDS, MC61, MC68, PARDISO and WSMP. The mapping +! used by MA86, MA87, MA97, SLBLT, MC61, MC68, PARDISO and WSMP. The mapping ! records out-of-range components and flags duplicates for summation. ! ! Entry l is mapped to positions MAP( l ) for j = 1, l = 1, ne. @@ -10953,7 +10930,7 @@ END SUBROUTINE SLS_coord_to_sorted_csr ! alloc_status ) ! !! Compute a mapping from the co-ordinate scheme to the row storage scheme -!! used by MA86, MA87, MA97, SSIDS, MC61, MC68, PARDISO and WSMP. The mapping +!! used by MA86, MA87, MA97, SLBLT, MC61, MC68, PARDISO and WSMP. The mapping !! records out-of-range components and flags duplicates for summation. !! !! Entry l is mapped to positions MAP( l ) for j = 1, l = 1, ne. diff --git a/src/sls/slsds.output b/src/sls/slsds.output index 9a65dfc782..8324de13a7 100644 --- a/src/sls/slsds.output +++ b/src/sls/slsds.output @@ -1,2 +1,2 @@ - solver ssids used + solver slblt used Solution is 1.00 2.00 3.00 4.00 5.00 diff --git a/src/sls/slss.f90 b/src/sls/slss.f90 index 6f579ee293..580169ad91 100644 --- a/src/sls/slss.f90 +++ b/src/sls/slss.f90 @@ -21,8 +21,8 @@ PROGRAM SLS_EXAMPLE ! GALAHAD 4.1 - 2022-11-27 AT 15:15 GMT. ! problem setup complete ! set right-hand side B( : n ) = (/ 8.0_wp, 45.0_wp, 31.0_wp, 15.0_wp, 17.0_wp /) -! specify the solver (in this case ssids) - CALL SLS_initialize( 'ssids', data, control, inform, check = .TRUE. ) +! specify the solver (in this case slblt) + CALL SLS_initialize( 'slblt', data, control, inform, check = .TRUE. ) WRITE( 6, "( ' solver ', A, ' used' )" ) TRIM( inform%solver ) ! analyse CALL SLS_analyse( matrix, data, control, inform ) diff --git a/src/sls/slss.output b/src/sls/slss.output index 9a65dfc782..8324de13a7 100644 --- a/src/sls/slss.output +++ b/src/sls/slss.output @@ -1,2 +1,2 @@ - solver ssids used + solver slblt used Solution is 1.00 2.00 3.00 4.00 5.00 diff --git a/src/sls/slst.F90 b/src/sls/slst.F90 index 978ad67593..1da718a7a5 100644 --- a/src/sls/slst.F90 +++ b/src/sls/slst.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 4.1 - 2023-01-24 AT 09:30 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 09:30 GMT. #include "galahad_modules.h" @@ -28,8 +28,8 @@ PROGRAM GALAHAD_SLS_test_program INTEGER ( KIND = ip_ ), PARAMETER :: potr = 12 INTEGER ( KIND = ip_ ), PARAMETER :: sytr = 13 INTEGER ( KIND = ip_ ), PARAMETER :: pbtr = 14 - INTEGER ( KIND = ip_ ), PARAMETER :: ssids = 15 - INTEGER ( KIND = ip_ ), PARAMETER :: all = ssids + INTEGER ( KIND = ip_ ), PARAMETER :: slblt = 15 + INTEGER ( KIND = ip_ ), PARAMETER :: all = slblt INTEGER ( KIND = ip_ ) :: ORDER( n ) REAL ( KIND = rp_ ) :: B( n ), X( n ), B2( n, 2 ), X2( n, 2 ), D( 2, n ) REAL ( KIND = rp_ ) :: B_diag( n ) @@ -119,12 +119,12 @@ PROGRAM GALAHAD_SLS_test_program ! DO solver = 12, 12 ! potr ! DO solver = 13, 13 ! sytr ! DO solver = 14, 14 ! pbtr -! DO solver = 15, 15 ! ssids +! DO solver = 15, 15 ! slblt ! IF ( solver == ma57 .OR. solver == ma86 .OR. solver == ma87 ) CYCLE SELECT CASE( solver ) CASE ( sils, ma57, ma77, ma86, ma97, pardiso, mkl_pardiso, & - wsmp, pastix, mumps, sytr, ssids ) ! indefinite + wsmp, pastix, mumps, sytr, slblt ) ! indefinite ! assign the matrix and right-hand side SELECT CASE( type ) CASE ( 1 ) @@ -204,9 +204,9 @@ PROGRAM GALAHAD_SLS_test_program ELSE IF ( solver == pbtr ) THEN WRITE( 6, "( ' pbtr ' )", advance = 'no' ) CALL SLS_initialize( 'pbtr', data, control, inform ) - ELSE IF ( solver == ssids ) THEN - WRITE( 6, "( ' ssids ' )", advance = 'no' ) - CALL SLS_initialize( 'ssids', data, control, inform ) + ELSE IF ( solver == slblt ) THEN + WRITE( 6, "( ' slblt ' )", advance = 'no' ) + CALL SLS_initialize( 'slblt', data, control, inform ) END IF control%scaling = 0 ! Analyse @@ -387,11 +387,11 @@ PROGRAM GALAHAD_SLS_test_program ! DO solver = 12, 12 ! potr ! DO solver = 13, 13 ! sytr ! DO solver = 14, 14 ! pbtr -! DO solver = 15, 15 ! ssids +! DO solver = 15, 15 ! slblt ! IF ( solver == ma57 .OR. solver == ma86 .OR. solver == ma87 ) CYCLE SELECT CASE( solver ) CASE ( sils, ma57, ma77, ma86, ma97, pardiso, mkl_pardiso, & - wsmp, pastix, mumps, sytr, ssids ) ! indefinite + wsmp, pastix, mumps, sytr, slblt ) ! indefinite ! assign the matrix and right-hand side SELECT CASE( type ) CASE ( 1 ) @@ -471,9 +471,9 @@ PROGRAM GALAHAD_SLS_test_program ELSE IF ( solver == pbtr ) THEN WRITE( 6, "( ' pbtr ' )", advance = 'no' ) CALL SLS_initialize( 'pbtr', data, control, inform ) - ELSE IF ( solver == ssids ) THEN - WRITE( 6, "( ' ssids ' )", advance = 'no' ) - CALL SLS_initialize( 'ssids', data, control, inform ) + ELSE IF ( solver == slblt ) THEN + WRITE( 6, "( ' slblt ' )", advance = 'no' ) + CALL SLS_initialize( 'slblt', data, control, inform ) END IF control%ordering = 0 ! Analyse @@ -688,7 +688,7 @@ PROGRAM GALAHAD_SLS_test_program ! DO solver = 12, 12 ! potr ! DO solver = 13, 13 ! sytr ! DO solver = 14, 14 ! pbtr -! DO solver = 15, 15 ! ssids +! DO solver = 15, 15 ! slblt ! Initialize the structures @@ -736,9 +736,9 @@ PROGRAM GALAHAD_SLS_test_program ELSE IF ( solver == pbtr ) THEN WRITE( 6, "( ' pbtr ' )", advance = 'no' ) CALL SLS_initialize( 'pbtr', data, control, inform ) - ELSE IF ( solver == ssids ) THEN - WRITE( 6, "( ' ssids ' )", advance = 'no' ) - CALL SLS_initialize( 'ssids', data, control, inform ) + ELSE IF ( solver == slblt ) THEN + WRITE( 6, "( ' slblt ' )", advance = 'no' ) + CALL SLS_initialize( 'slblt', data, control, inform ) END IF control%error = - 1 ; control%warning = - 1 control%out = - 1 ; control%statistics = - 1 ; control%print_level = - 1 @@ -783,8 +783,8 @@ PROGRAM GALAHAD_SLS_test_program CALL SLS_initialize( 'sytr', data, control, inform ) ELSE IF ( solver == pbtr ) THEN CALL SLS_initialize( 'pbtr', data, control, inform ) - ELSE IF ( solver == ssids ) THEN - CALL SLS_initialize( 'ssids', data, control, inform ) + ELSE IF ( solver == slblt ) THEN + CALL SLS_initialize( 'slblt', data, control, inform ) END IF control%error = - 1 ; control%warning = - 1 control%out = - 1 ; control%statistics = - 1 ; control%print_level = - 1 diff --git a/src/sls/usesls.F90 b/src/sls/usesls.F90 index e56e267119..9be3b57a0d 100644 --- a/src/sls/usesls.F90 +++ b/src/sls/usesls.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.2 - 2025-05-04 AT 14:40 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 14:40 GMT. #include "galahad_modules.h" #include "cutest_routines.h" @@ -99,7 +99,7 @@ SUBROUTINE USE_SLS( input ) CHARACTER ( LEN = 16 ) :: specname = 'RUNSLS' TYPE ( SPECFILE_item_type ), DIMENSION( lspec ) :: spec CHARACTER ( LEN = 16 ) :: runspec = 'RUNSLS.SPC' - CHARACTER ( LEN = 30 ) :: solver = "ssids" // REPEAT( ' ', 25 ) + CHARACTER ( LEN = 30 ) :: solver = "slblt" // REPEAT( ' ', 25 ) ! The default values for SLS could have been set as: @@ -114,7 +114,7 @@ SUBROUTINE USE_SLS( input ) ! write-result-summary NO ! result-summary-file-name SLSRES.d ! result-summary-file-device 47 -! symmetric-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt ! kkt-system YES ! barrier-perturbation 1.0 ! solution-passes 1 diff --git a/src/ssids/Julia/ssids.jl b/src/ssids/Julia/ssids.jl deleted file mode 120000 index ad0892143d..0000000000 --- a/src/ssids/Julia/ssids.jl +++ /dev/null @@ -1 +0,0 @@ -../../../GALAHAD.jl/src/wrappers/ssids.jl \ No newline at end of file diff --git a/src/ssids/Julia/test_ssids.jl b/src/ssids/Julia/test_ssids.jl deleted file mode 120000 index aea91f69c1..0000000000 --- a/src/ssids/Julia/test_ssids.jl +++ /dev/null @@ -1 +0,0 @@ -../../../GALAHAD.jl/test/test_ssids.jl \ No newline at end of file diff --git a/src/ssids/LICENCE b/src/ssids/LICENCE deleted file mode 100644 index 5c07a88395..0000000000 --- a/src/ssids/LICENCE +++ /dev/null @@ -1,24 +0,0 @@ -Copyright (c) 2014-6, The Science and Technology Facilities Council (STFC) -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - * Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. - * Neither the name of the STFC nor the names of its contributors may be - used to endorse or promote products derived from this software without - specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL STFC BE LIABLE FOR ANY DIRECT, INDIRECT, -INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE -OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/src/ssids/NumericSubtree.cxx b/src/ssids/NumericSubtree.cxx deleted file mode 100644 index 66609bdb85..0000000000 --- a/src/ssids/NumericSubtree.cxx +++ /dev/null @@ -1,271 +0,0 @@ -// version GALAHAD 5.1 - 2025-08-13 AT 14:10 GMT -// copyright 2016 The Science and Technology Facilities Council (STFC) -// licence BSD licence, see LICENCE file for details -// author Jonathan Hogg - -#include "ssids_cpu_NumericSubtree.hxx" - -#include -#include -#include - -#include "ssids_routines.h" -#include "galahad_precision.h" -#include "ssids_omp.hxx" -#include "ssids_cpu_AppendAlloc.hxx" - -using namespace galahad::ssids::cpu; - -///////////////////////////////////////////////////////////////////////////// -// anonymous namespace -namespace { - -#ifdef REAL_32 -typedef float T; -#elif REAL_128 -typedef __float128 T; -#else -typedef double T; -#endif -const ipc_ PAGE_SIZE = 8*1024*1024; // 8MB -typedef NumericSubtree> NumericSubtreePosdef; -typedef NumericSubtree> NumericSubtreeIndef; - -} /* end of anon namespace */ -////////////////////////////////////////////////////////////////////////// - -extern "C" -void* galahad_ssids_cpu_create_num_subtree( - bool posdef, - void const* symbolic_subtree_ptr, - const rpc_ *const aval, // Values of A - const rpc_ *const scaling, // Scaling vector (NULL if none) - void** child_contrib, // Contributions from child subtrees - struct cpu_factor_control const* control, // Options in - ThreadStats* stats // Info out - ) { - auto const& symbolic_subtree = - *static_cast(symbolic_subtree_ptr); - - // Perform factorization - if(posdef) { - auto* subtree = new NumericSubtreePosdef - (symbolic_subtree, aval, scaling, child_contrib, *control, *stats); - if(control->print_level > 9999) { - printf("Final factors:\n"); - subtree->print(); - } - return (void*) subtree; - } else { /* indef */ - auto* subtree = new NumericSubtreeIndef - (symbolic_subtree, aval, scaling, child_contrib, *control, *stats); - if(control->print_level > 9999) { - printf("Final factors:\n"); - subtree->print(); - } - return (void*) subtree; - } -} - -extern "C" -void galahad_ssids_cpu_destroy_num_subtree(bool posdef, void* target) { - if(!target) return; - - if(posdef) { - auto *subtree = static_cast(target); - delete subtree; - } else { - auto *subtree = static_cast(target); - delete subtree; - } -} - -/* wrapper around templated routines */ -extern "C" -Flag galahad_ssids_cpu_subtree_solve_fwd( - bool posdef, // If true, performs A=LL^T, if false do pivoted A=LDL^T - void const* subtree_ptr,// pointer to relevant type of NumericSubtree - ipc_ nrhs, // number of right-hand sides - rpc_* x, // ldx x nrhs array of right-hand sides - ipc_ ldx // leading dimension of x - ) { - - // Call method - try { - if(posdef) { // Converting from runtime to compile time posdef value - auto &subtree = - *static_cast(subtree_ptr); - subtree.solve_fwd(nrhs, x, ldx); - } else { - auto &subtree = - *static_cast(subtree_ptr); - subtree.solve_fwd(nrhs, x, ldx); - } - } catch(std::bad_alloc const&) { - return Flag::ERROR_ALLOCATION; - } - return Flag::SUCCESS; -} - -/* wrapper around templated routines */ -extern "C" -Flag galahad_ssids_cpu_subtree_solve_diag( - bool posdef, // If true, performs A=LL^T, if false do pivoted A=LDL^T - void const* subtree_ptr,// pointer to relevant type of NumericSubtree - ipc_ nrhs, // number of right-hand sides - rpc_* x, // ldx x nrhs array of right-hand sides - ipc_ ldx // leading dimension of x - ) { - - // Call method - try { - if(posdef) { // Converting from runtime to compile time posdef value - auto &subtree = *static_cast(subtree_ptr); - subtree.solve_diag(nrhs, x, ldx); - } else { - auto &subtree = *static_cast(subtree_ptr); - subtree.solve_diag(nrhs, x, ldx); - } - } catch(std::bad_alloc const&) { - return Flag::ERROR_ALLOCATION; - } - return Flag::SUCCESS; -} - -/* wrapper around templated routines */ -extern "C" -Flag galahad_ssids_cpu_subtree_solve_diag_bwd( - bool posdef, // If true, performs A=LL^T, if false do pivoted A=LDL^T - void const* subtree_ptr,// pointer to relevant type of NumericSubtree - ipc_ nrhs, // number of right-hand sides - rpc_* x, // ldx x nrhs array of right-hand sides - ipc_ ldx // leading dimension of x - ) { - - // Call method - try { - if(posdef) { // Converting from runtime to compile time posdef value - auto &subtree = - *static_cast(subtree_ptr); - subtree.solve_diag_bwd(nrhs, x, ldx); - } else { - auto &subtree = - *static_cast(subtree_ptr); - subtree.solve_diag_bwd(nrhs, x, ldx); - } - } catch(std::bad_alloc const&) { - return Flag::ERROR_ALLOCATION; - } - return Flag::SUCCESS; -} - -/* wrapper around templated routines */ -extern "C" -Flag galahad_ssids_cpu_subtree_solve_bwd( - bool posdef, // If true, performs A=LL^T, if false do pivoted A=LDL^T - void const* subtree_ptr,// pointer to relevant type of NumericSubtree - ipc_ nrhs, // number of right-hand sides - rpc_* x, // ldx x nrhs array of right-hand sides - ipc_ ldx // leading dimension of x - ) { - - // Call method - try { - if(posdef) { // Converting from runtime to compile time posdef value - auto &subtree = - *static_cast(subtree_ptr); - subtree.solve_bwd(nrhs, x, ldx); - } else { - auto &subtree = - *static_cast(subtree_ptr); - subtree.solve_bwd(nrhs, x, ldx); - } - } catch(std::bad_alloc const&) { - return Flag::ERROR_ALLOCATION; - } - return Flag::SUCCESS; -} - -/* wrapper around templated routines */ -extern "C" -void galahad_ssids_cpu_subtree_enquire( - bool posdef, // If true, performs A=LL^T, if false do pivoted A=LDL^T - void const* subtree_ptr,// pointer to relevant type of NumericSubtree - ipc_* piv_order, // pivot order, may be null, only used if indef - rpc_* d // diagonal entries, may be null - ) { - - // Call method - if(posdef) { // Converting from runtime to compile time posdef value - auto &subtree = - *static_cast(subtree_ptr); - subtree.enquire(piv_order, d); - } else { - auto &subtree = - *static_cast(subtree_ptr); - subtree.enquire(piv_order, d); - } -} - -/* wrapper around templated routines */ -extern "C" -void galahad_ssids_cpu_subtree_alter( - bool posdef, // If true, performs A=LL^T, if false do pivoted A=LDL^T - void* subtree_ptr,// pointer to relevant type of NumericSubtree - rpc_ const* d // new diagonal entries - ) { - - assert(!posdef); // Should never be called on positive definite matrices. - - // Call method - auto &subtree = *static_cast(subtree_ptr); - subtree.alter(d); -} - -/* wrapper around templated routines */ -extern "C" -void galahad_ssids_cpu_subtree_get_contrib( - bool posdef, // If true, performs A=LL^T, if false do pivoted A=LDL^T - void* subtree_ptr,// pointer to relevant type of NumericSubtree - ipc_* n, // returned dimension of contribution block - rpc_ const** val, // returned pointer to contribution block - ipc_* ldval, // leading dimension of val - ipc_ const** rlist, // returned pointer to row list - ipc_* ndelay, // returned number of delays - ipc_ const** delay_perm, // returned pointer to delay values - rpc_ const** delay_val, // returned pointer to delay values - ipc_* lddelay // leading dimension of delay_val - ) { - // Call method - if(posdef) { // Converting from runtime to compile time posdef value - auto &subtree = - *static_cast(subtree_ptr); - subtree.get_contrib( - *n, *val, *ldval, *rlist, *ndelay, *delay_perm, *delay_val, *lddelay - ); - } else { - auto &subtree = - *static_cast(subtree_ptr); - subtree.get_contrib( - *n, *val, *ldval, *rlist, *ndelay, *delay_perm, *delay_val, *lddelay - ); - } -} - -/* wrapper around templated routines */ -extern "C" -void galahad_ssids_cpu_subtree_free_contrib( - bool posdef, // If true, performs A=LL^T, if false do pivoted A=LDL^T - void* subtree_ptr // pointer to relevant type of NumericSubtree - ) { - // Call method - if(posdef) { // Converting from runtime to compile time posdef value - auto &subtree = - *static_cast(subtree_ptr); - subtree.free_contrib(); - } else { - auto &subtree = - *static_cast(subtree_ptr); - subtree.free_contrib(); - } -} diff --git a/src/ssids/README b/src/ssids/README deleted file mode 100644 index 8d553ebf05..0000000000 --- a/src/ssids/README +++ /dev/null @@ -1,20 +0,0 @@ -This is a fork of the GPU/CPU sparse, symmetric indefinite direct -linear solver SSIDS that is available as part of the open-source -sparse parallel robust algorithms library SPRAL: - - https://github.com/ralna/spral - https://ralna.github.io/spral/ - -Since the SPRAL GPU code no longer works, the GALAHAD fork is only -for CPUs. The fork also adds that following functionality - - * multiple real precision support - * both 32 and 64 bit integer support - * native nested-dissection ordering rather than requiring - an external version of MeTiS - * Python and Julia support as well as C - * adoption of GALAHAD coding style where possible - -Jari Fowkes, Nick Gould and Alexis Montoison -for GALAHAD productions -August 14th 2025 diff --git a/src/ssids/SymbolicSubtree.cxx b/src/ssids/SymbolicSubtree.cxx deleted file mode 100644 index ad51abef4b..0000000000 --- a/src/ssids/SymbolicSubtree.cxx +++ /dev/null @@ -1,32 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version GALAHAD 5.3 - 2025-08-13 AT 13:20 GMT - */ - -#include "ssids_routines.h" -#include "galahad_precision.h" -#include "ssids_cpu_SymbolicSubtree.hxx" - -using namespace galahad::ssids::cpu; - -extern "C" -void* galahad_ssids_cpu_create_symbolic_subtree( - ipc_ n, ipc_ sa, ipc_ en, ipc_ const* sptr, ipc_ const* sparent, - longc_ const* rptr, ipc_ const* rlist, longc_ const* nptr, - longc_ const* nlist, ipc_ ncontrib, ipc_ const* contrib_idx, - struct cpu_factor_control const* control) { - return (void*) new SymbolicSubtree( - n, sa, en, sptr, sparent, rptr, rlist, nptr, nlist, ncontrib, - contrib_idx, *control - ); -} - -extern "C" -void galahad_ssids_cpu_destroy_symbolic_subtree(void* target) { - if(!target) return; - - auto *subtree = static_cast(target); - delete subtree; -} diff --git a/src/ssids/ThreadStats.cxx b/src/ssids/ThreadStats.cxx deleted file mode 100644 index 2e9f68c7d8..0000000000 --- a/src/ssids/ThreadStats.cxx +++ /dev/null @@ -1,35 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 09:00 GMT - */ -#include "ssids_cpu_ThreadStats.hxx" - -#include - -namespace galahad { namespace ssids { namespace cpu { - -/** \brief Reduce with stats from another thread. - * - * This operation is designed so that thread stats can be consolidated - * sensibly at the end of factorization. - */ -ThreadStats& ThreadStats::operator+=(ThreadStats const& other) { - flag = (flag<0 || other.flag<0) ? std::min(flag, other.flag) // error - : std::max(flag, other.flag);// warning/pass - num_delay += other.num_delay; - num_factor += other.num_factor; - num_flops += other.num_flops; - num_neg += other.num_neg; - num_two += other.num_two; - num_zero += other.num_zero; - maxfront = std::max(maxfront, other.maxfront); - maxsupernode = std::max(maxsupernode, other.maxsupernode); - not_first_pass += other.not_first_pass; - not_second_pass += other.not_second_pass; - - return *this; -} - -}}} /* namespace galahad::ssids::cpu */ diff --git a/src/ssids/cholesky.cxx b/src/ssids/cholesky.cxx deleted file mode 100644 index 543a1ead42..0000000000 --- a/src/ssids/cholesky.cxx +++ /dev/null @@ -1,214 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 09:00 GMT - */ - - - -#include -#include // FIXME: remove as only used for debug - -#include "ssids_cpu_kernels_cholesky.hxx" -#include "ssids_cpu_kernels_wrappers.hxx" - -namespace galahad { namespace ssids { namespace cpu { - -/** Perform Cholesky factorization of lower triangular matrix a[] in place. - * Optionally calculates the contribution block (beta*C) - LL^T. - * - * \param m the number of rows - * \param n the number of columns - * \param a the matrix to be factorized, only lower triangle is used, however - * upper triangle may get overwritten with rubbish - * \param lda the leading dimension of a - * \param beta the coefficient to multiply C by (normally 0.0 or 1.0) - * \param upd the (m-n) x (m-n) contribution block C (may be null) - * \param ldup the leading dimension of upd - * \param blksz the block size to use for parallelization. Blocks are aimed to - * contain at most blksz**2 entries. - * \param info is initialized to -1, and will be changed to the index of any - * column where a non-zero column is encountered. - */ -void cholesky_factor(ipc_ m, ipc_ n, rpc_* a, ipc_ lda, rpc_ beta, - rpc_* upd, ipc_ ldupd, ipc_ blksz, ipc_ *info) { - if(n < blksz) { - // Adjust so blocks have blksz**2 entries - blksz = ipc_((long(blksz)*blksz) / n); - } - - #pragma omp atomic write - *info = -1; - - /* FIXME: Would this be better row-wise to ensure critical path, rather than - * its current col-wise implementation ensuring maximum work available??? */ - #pragma omp taskgroup - - for(ipc_ j = 0; j < n; j += blksz) { - ipc_ blkn = std::min(blksz, n-j); - /* Diagonal Block Factorization Task */ - #pragma omp task default(none) \ - firstprivate(j, blkn) \ - shared(m, a, lda, blksz, info, beta, upd, ldupd) \ - depend(inout: a[j*(lda+1):1]) - { - ipc_ my_info; - #pragma omp atomic read - my_info = *info; - if (my_info == -1) { - ipc_ blkm = std::min(blksz, m-j); - ipc_ flag = lapack_potrf(FILL_MODE_LWR, blkn, &a[j*(lda+1)], lda); - if (flag > 0) { - // Matrix was not positive definite - #pragma omp atomic write - *info = flag-1; // flag uses Fortran indexing - } else if (blkm > blkn) { - // Diagonal block factored OK, handle some rectangular part of block - rpc_ one_val = 1.0; - rpc_ minus_one_val = - 1.0; - host_trsm(SIDE_RIGHT, FILL_MODE_LWR, OP_T, DIAG_NON_UNIT, - blkm-blkn, blkn, one_val, &a[j*(lda+1)], lda, - &a[j*(lda+1)+blkn], lda); - if (upd) { - rpc_ rbeta = (j==0) ? beta : 1.0; - host_syrk(FILL_MODE_LWR, OP_N, blkm-blkn, blkn, minus_one_val, - &a[j*(lda+1)+blkn], lda, rbeta, upd, ldupd); - } - } - } - } - /* Column Solve Tasks */ - for (ipc_ i = j+blksz; i < m; i += blksz) { - ipc_ blkm = std::min(blksz, m-i); - #pragma omp task default(none) \ - firstprivate(i, j, blkn, blkm) \ - shared(a, lda, info, beta, upd, ldupd, blksz, n) \ - depend(in: a[j*(lda+1):1]) \ - depend(inout: a[j*lda + i:1]) - { - ipc_ my_info; - #pragma omp atomic read - my_info = *info; - if (my_info == -1) { - rpc_ one_val = 1.0; - rpc_ minus_one_val = - 1.0; - host_trsm(SIDE_RIGHT, FILL_MODE_LWR, OP_T, DIAG_NON_UNIT, blkm, - blkn, one_val, &a[j*(lda+1)], lda, &a[j*lda+i], lda); - if ((blkn < blksz) && upd) { - rpc_ rbeta = (j==0) ? beta : 1.0; - host_gemm(OP_N, OP_T, blkm, blksz-blkn, blkn, minus_one_val, - &a[j*lda+i], lda, &a[j*(lda+1)+blkn], lda, - rbeta, &upd[i-n], ldupd); - } - } - } - } - /* Schur Update Tasks: mostly internal */ - for (ipc_ k = j+blksz; k < n; k += blksz) { - ipc_ blkk = std::min(blksz, n-k); - for (ipc_ i = k; i < m; i += blksz) { - #pragma omp task default(none) \ - firstprivate(i, j, k, blkn, blkk) \ - shared(m, a, lda, blksz, info, beta, upd, ldupd, n) \ - depend(in: a[j*lda+k:1]) \ - depend(in: a[j*lda+i:1]) \ - depend(inout: a[k*lda+i:1]) - { - ipc_ my_info; - #pragma omp atomic read - my_info = *info; - if (my_info == -1) { - ipc_ blkm = std::min(blksz, m-i); - rpc_ one_val = 1.0; - rpc_ minus_one_val = - 1.0; - host_gemm(OP_N, OP_T, blkm, blkk, blkn, minus_one_val, - &a[j*lda+i], lda, &a[j*lda+k], lda, one_val, - &a[k*lda+i], lda); - if ((blkk < blksz) && upd) { - rpc_ rbeta = (j==0) ? beta : 1.0; - ipc_ upd_width = (m n) - gemv(OP_N, m-n, n, minus_one_val, &a[n], lda, x, one_integer, one_val, &x[n], one_integer); - } else { - host_trsm(SIDE_LEFT, FILL_MODE_LWR, OP_N, DIAG_NON_UNIT, n, nrhs, - one_val, a, lda, x, ldx); - if(m > n) - host_gemm(OP_N, OP_N, m-n, nrhs, n, minus_one_val, &a[n], lda, x, - ldx, one_val, &x[n], ldx); - } -} - -/* Backwards solve corresponding to cholesky_factor() */ -void cholesky_solve_bwd(ipc_ m, ipc_ n, rpc_ const* a, ipc_ lda, - ipc_ nrhs, rpc_* x, ipc_ ldx) { - rpc_ one_val = 1.0; - rpc_ minus_one_val = - 1.0; - ipc_ one_integer = 1; - if(nrhs==one_integer) { - if(m > n) - gemv(OP_T, m-n, n, minus_one_val, &a[n], lda, &x[n], one_integer, one_val, x, one_integer); - host_trsv(FILL_MODE_LWR, OP_T, DIAG_NON_UNIT, n, a, lda, x, one_integer); - } else { - if(m > n) - host_gemm(OP_T, OP_N, n, nrhs, m-n, minus_one_val, &a[n], lda, &x[n], - ldx, one_val, x, ldx); - host_trsm(SIDE_LEFT, FILL_MODE_LWR, OP_T, DIAG_NON_UNIT, n, nrhs, - one_val, a, lda, x, ldx); - } -} - -}}} /* namespaces galahad::ssids::cpu */ diff --git a/src/ssids/contrib_iface.F90 b/src/ssids/contrib_iface.F90 deleted file mode 100644 index eef047a6ef..0000000000 --- a/src/ssids/contrib_iface.F90 +++ /dev/null @@ -1,129 +0,0 @@ -! THIS VERSION: GALAHAD 5.3 - 2025-08-31 AT 10:00 GMT - -#include "galahad_modules.h" -#include "ssids_routines.h" - -! COPYRIGHT (c) 2016 The Science and Technology Facilities Council (STFC) -! author: Jonathan Hogg -! licence: BSD licence, see LICENCE file for details -! Forked and extended for GALAHAD, Nick Gould, version 3.1, 2016 -! A combination of contrib and contrib_free, with a removal of the -! unnecessary module SSIDS_contrib_fsub_precision, and the transfer of -! module SSIDS_contrib to GALAHAD_types, GALAHAD 5.3, 2025-08-27 - -!!$ MODULE GALAHAD_SSIDS_contrib_fsub_precision -!!$ -!!$! routines for freeing contrib_type -!!$! -!!$! as the module depends on routines defined by module that use the type, -!!$! it needs to be a seperate module to GALAHAD_SSIDS_contrib_precision -!!$ -!!$ USE GALAHAD_KINDS_precision -!!$ IMPLICIT NONE -!!$ -!!$ CONTAINS -!!$ -!!$!- G A L A H A D - S S I D S _ c o n t r i b _f s u b S U B R O U T I N E -!!$ -!!$ SUBROUTINE contrib_free( fcontrib ) -!!$ IMPLICIT none -!!$ TYPE( contrib_type ), INTENT( INOUT ) :: fcontrib -!!$ SELECT CASE( contrib%owner ) -!!$ CASE ( 0 ) ! CPU -!!$ CALL cpu_free_contrib( contrib%posdef, contrib%owner_ptr ) -!!$ CASE ( 1 ) ! GPU -!!$ CALL gpu_free_contrib( contrib ) -!!$ CASE DEFAULT ! This should never happen -!!$ PRINT *, "Unrecognised contrib owner ", contrib%owner -!!$ STOP - 1 -!!$ END SELECT -!!$ RETURN -!!$ -!!$ END SUBROUTINE contrib_free -!!$ END MODULE GALAHAD_SSIDS_contrib_fsub_precision - -! G A L A H A D - S S I D S _ c o n t r i b _g e t _d a t a S U B R O U T I N E - - SUBROUTINE GALAHAD_SSIDS_contrib_get_data_precision( ccontrib, n, val, & - ldval, rlist, ndelay, & - delay_perm, delay_val, & - lddelay ) BIND( C ) - -! C function to get interesting components of the contrib type - - USE GALAHAD_KINDS_precision - USE GALAHAD_SSIDS_types_precision, ONLY: contrib_type - IMPLICIT NONE - - TYPE( C_PTR ), VALUE :: ccontrib - INTEGER( C_IP_ ), INTENT( OUT ) :: n - TYPE( C_PTR ), INTENT( OUT ) :: val - INTEGER( C_IP_ ), INTENT( OUT ) :: ldval - TYPE( C_PTR ), INTENT( OUT ) :: rlist - INTEGER( C_IP_ ), INTENT( OUT ) :: ndelay - TYPE( C_PTR ), INTENT( OUT ) :: delay_perm - TYPE( C_PTR ), INTENT( OUT ) :: delay_val - INTEGER( C_IP_ ), INTENT( OUT ) :: lddelay - - TYPE( contrib_type ), POINTER, VOLATILE :: fcontrib - - IF ( C_ASSOCIATED( ccontrib ) ) THEN - CALL C_F_POINTER( ccontrib, fcontrib ) - - DO WHILE ( .NOT. fcontrib%ready ) - ! FIXME: make below a taskyield? (was: flush) -!$omp taskyield - END DO - - n = fcontrib%n - val = C_LOC( fcontrib%val ) - ldval = fcontrib%ldval - rlist = C_LOC( fcontrib%rlist ) - ndelay = fcontrib%ndelay - IF ( ASSOCIATED( fcontrib%delay_val ) ) THEN - delay_perm = C_LOC( fcontrib%delay_perm ) - delay_val = C_LOC( fcontrib%delay_val ) - ELSE - delay_perm = C_NULL_PTR - delay_val = C_NULL_PTR - END IF - lddelay = fcontrib%lddelay - END IF - RETURN - - END SUBROUTINE GALAHAD_SSIDS_contrib_get_data_precision - -!- G A L A H A D - S S I D S _ c o n t r i b _f r e e S U B R O U T I N E - - - SUBROUTINE GALAHAD_SSIDS_contrib_free_precision( ccontrib ) BIND( C ) - -! the C prototype for the following routine is in contrib.h - - USE, INTRINSIC :: iso_c_binding - USE GALAHAD_SSIDS_types_precision, ONLY: contrib_type - USE GALAHAD_SSIDS_cpu_subtree_precision, ONLY: cpu_free_contrib -! USE GALAHAD_SSIDS_gpu_subtree_precision, ONLY: gpu_free_contrib -! USE GALAHAD_SSIDS_contrib_fsub_precision - IMPLICIT NONE - - TYPE( C_PTR ), VALUE :: ccontrib - - TYPE( contrib_type ), POINTER :: fcontrib - - IF ( C_ASSOCIATED( ccontrib ) ) THEN - CALL C_F_POINTER( ccontrib, fcontrib ) - SELECT CASE( fcontrib%owner ) - CASE ( 0 ) ! CPU - CALL cpu_free_contrib( fcontrib%posdef, fcontrib%owner_ptr ) - CASE ( 1 ) ! GPU -! CALL gpu_free_contrib( fcontrib ) - fcontrib%n = 0 - CASE DEFAULT ! This should never happen - PRINT *, "Unrecognised contrib owner ", fcontrib%owner - STOP - 1 - END SELECT -! CALL contrib_free( fcontrib ) - END IF - RETURN - - END SUBROUTINE GALAHAD_SSIDS_contrib_free_precision diff --git a/src/ssids/cpu_iface.F90 b/src/ssids/cpu_iface.F90 deleted file mode 100644 index 419de320bd..0000000000 --- a/src/ssids/cpu_iface.F90 +++ /dev/null @@ -1,260 +0,0 @@ -! THIS VERSION: GALAHAD 5.3 - 2025-08-31 AT 10:00 GMT - -! COPYRIGHT (c) 2016 The Science and Technology Facilities Council (STFC) -! author: Jonathan Hogg -! licence: BSD licence, see LICENCE file for details -! Forked and extended for GALAHAD, Nick Gould, version 3.1, 2016 - -#include "galahad_lapack.h" -#include "galahad_modules.h" - -#ifdef REAL_32 -#ifdef INTEGER_64 -#define spral_c_gemv spral_c_sgemv_64 -#define spral_c_trsv spral_c_strsv_64 -#define spral_c_syrk spral_c_ssyrk_64 -#define spral_c_trsm spral_c_strsm_64 -#define spral_c_sytrf spral_c_ssytrf_64 -#define spral_c_potrf spral_c_spotrf_64 -#define spral_c_gemm spral_c_sgemm_64 -#define GALAHAD_BLAS_inter_precision GALAHAD_BLAS_inter_single_64 -#define GALAHAD_LAPACK_inter_precision GALAHAD_LAPACK_inter_single_64 -#else -#define spral_c_gemv spral_c_sgemv -#define spral_c_trsv spral_c_strsv -#define spral_c_syrk spral_c_ssyrk -#define spral_c_trsm spral_c_strsm -#define spral_c_sytrf spral_c_ssytrf -#define spral_c_potrf spral_c_spotrf -#define spral_c_gemm spral_c_sgemm -#define GALAHAD_BLAS_inter_precision GALAHAD_BLAS_inter_single -#define GALAHAD_LAPACK_inter_precision GALAHAD_LAPACK_inter_single -#endif -#elif REAL_128 -#ifdef INTEGER_64 -#define spral_c_gemv spral_c_qgemv_64 -#define spral_c_trsv spral_c_qtrsv_64 -#define spral_c_syrk spral_c_qsyrk_64 -#define spral_c_trsm spral_c_qtrsm_64 -#define spral_c_sytrf spral_c_qsytrf_64 -#define spral_c_potrf spral_c_qpotrf_64 -#define spral_c_gemm spral_c_qgemm_64 -#define GALAHAD_BLAS_inter_precision GALAHAD_BLAS_inter_quadruple_64 -#define GALAHAD_LAPACK_inter_precision GALAHAD_LAPACK_inter_quadruple_64 -#else -#define spral_c_gemv spral_c_qgemv -#define spral_c_trsv spral_c_qtrsv -#define spral_c_syrk spral_c_qsyrk -#define spral_c_trsm spral_c_qtrsm -#define spral_c_sytrf spral_c_qsytrf -#define spral_c_potrf spral_c_qpotrf -#define spral_c_gemm spral_c_qgemm -#define GALAHAD_BLAS_inter_precision GALAHAD_BLAS_inter_quadruple -#define GALAHAD_LAPACK_inter_precision GALAHAD_LAPACK_inter_quadruple -#endif -#else -#ifdef INTEGER_64 -#define spral_c_gemv spral_c_dgemv_64 -#define spral_c_trsv spral_c_dtrsv_64 -#define spral_c_syrk spral_c_dsyrk_64 -#define spral_c_trsm spral_c_dtrsm_64 -#define spral_c_sytrf spral_c_dsytrf_64 -#define spral_c_potrf spral_c_dpotrf_64 -#define spral_c_gemm spral_c_dgemm_64 -#define GALAHAD_BLAS_inter_precision GALAHAD_BLAS_inter_double_64 -#define GALAHAD_LAPACK_inter_precision GALAHAD_LAPACK_inter_double_64 -#else -#define spral_c_gemv spral_c_dgemv -#define spral_c_trsv spral_c_dtrsv -#define spral_c_syrk spral_c_dsyrk -#define spral_c_trsm spral_c_dtrsm -#define spral_c_sytrf spral_c_dsytrf -#define spral_c_potrf spral_c_dpotrf -#define spral_c_gemm spral_c_dgemm -#define GALAHAD_BLAS_inter_precision GALAHAD_BLAS_inter_double -#define GALAHAD_LAPACK_inter_precision GALAHAD_LAPACK_inter_double -#endif -#endif - - MODULE GALAHAD_SSIDS_cpu_iface_precision - USE GALAHAD_KINDS_precision - USE, INTRINSIC :: iso_c_binding - USE GALAHAD_SSIDS_types_precision, ONLY: SSIDS_control_type, & - SSIDS_inform_type - USE GALAHAD_BLAS_inter_precision, ONLY: GEMV, GEMM, TRSV, TRSM, SYRK - USE GALAHAD_LAPACK_inter_precision, ONLY: SYTRF, POTRF - IMPLICIT none - - PRIVATE - PUBLIC :: cpu_factor_control, cpu_factor_stats - PUBLIC :: cpu_copy_control_in, cpu_copy_stats_out - -! interoperable subset of ssids_control -! Interoperates with cpu_factor_control C++ type -! see also galahad_ssids_types_precision::ssids_control -! galahad::ssids::cpu::cpu_factor_control - - TYPE, BIND( C ) :: cpu_factor_control - INTEGER( KIND = C_IP_ ) :: print_level - LOGICAL(C_BOOL) :: action - REAL( KIND = C_RP_ ) :: small - REAL( KIND = C_RP_ ) :: u - REAL( KIND = C_RP_ ) :: multiplier - INTEGER( KIND = C_INT64_T ) :: small_subtree_threshold - INTEGER( KIND = C_IP_ ) :: cpu_block_size - INTEGER( KIND = C_IP_ ) :: pivot_method - INTEGER( KIND = C_IP_ ) :: failed_pivot_method - END TYPE cpu_factor_control - -! interoperable subset of ssids_inform -! interoperates with ThreadStats C++ type -! see also galahad_ssids_inform_precision::ssids_inform -! galahad::ssids::cpu::ThreadStats - - TYPE, BIND( C ) :: cpu_factor_stats - INTEGER( KIND = C_IP_ ) :: flag - INTEGER( KIND = C_IP_ ) :: num_delay - INTEGER( KIND = C_INT64_T ) :: num_factor - INTEGER( KIND = C_INT64_T ) :: num_flops - INTEGER( KIND = C_IP_ ) :: num_neg - INTEGER( KIND = C_IP_ ) :: num_two - INTEGER( KIND = C_IP_ ) :: num_zero - INTEGER( KIND = C_IP_ ) :: maxfront - INTEGER( KIND = C_IP_ ) :: maxsupernode - INTEGER( KIND = C_IP_ ) :: not_first_pass - INTEGER( KIND = C_IP_ ) :: not_second_pass - END TYPE cpu_factor_stats - - CONTAINS - - SUBROUTINE cpu_copy_control_in( fcontrol, ccontrol ) - -! copy subset of ssids_control to interoperable type - - TYPE( SSIDS_control_type ), INTENT( IN ) :: fcontrol - TYPE( cpu_factor_control ), INTENT( OUT ) :: ccontrol - - ccontrol%print_level = fcontrol%print_level - ccontrol%action = fcontrol%action - ccontrol%small = fcontrol%small - ccontrol%u = fcontrol%u - ccontrol%multiplier = fcontrol%multiplier - ccontrol%small_subtree_threshold = fcontrol%small_subtree_threshold - ccontrol%cpu_block_size = fcontrol%cpu_block_size - ccontrol%pivot_method = MIN( 3, MAX( 1, fcontrol%pivot_method ) ) - ccontrol%failed_pivot_method = MIN( 2, MAX(1, fcontrol%failed_pivot_method )) - RETURN - - END SUBROUTINE cpu_copy_control_in - - SUBROUTINE cpu_copy_stats_out( cstats, finform ) - -! copy subset of ssids_inform from interoperable type - - TYPE( cpu_factor_stats ), INTENT( IN ) :: cstats - TYPE( SSIDS_inform_type ), INTENT( INOUT ) :: finform - - ! Combine stats - IF ( cstats%flag < 0 ) THEN - finform%flag = MIN( finform%flag, cstats%flag ) ! error - ELSE - finform%flag = MAX( finform%flag, cstats%flag ) ! success or warning - END IF - finform%num_delay = finform%num_delay + cstats%num_delay - finform%num_factor = finform%num_factor + cstats%num_factor - finform%num_flops = finform%num_flops + cstats%num_flops - finform%num_neg = finform%num_neg + cstats%num_neg - finform%num_two = finform%num_two + cstats%num_two - finform%maxfront = MAX( finform%maxfront, cstats%maxfront ) - finform%maxsupernode = MAX( finform%maxsupernode, cstats%maxsupernode ) - finform%not_first_pass = finform%not_first_pass + cstats%not_first_pass - finform%not_second_pass = finform%not_second_pass + cstats%not_second_pass - finform%matrix_rank = finform%matrix_rank - cstats%num_zero - RETURN - - END SUBROUTINE cpu_copy_stats_out - -! wrapper functions for BLAS/LAPACK routines for standard conforming - - SUBROUTINE spral_c_gemm( ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, & - c, ldc ) BIND( C ) - -! interopability calls from C - - USE GALAHAD_KINDS_precision, only: C_IP_, C_RP_ - CHARACTER( C_CHAR ), INTENT( IN ) :: ta, tb - INTEGER( KIND = C_IP_ ), INTENT( IN ) :: m, n, k - INTEGER( KIND = C_IP_ ), INTENT( IN ) :: lda, ldb, ldc - REAL( KIND = C_RP_ ), INTENT( IN ) :: alpha, beta - REAL( KIND = C_RP_ ), INTENT( IN ), DIMENSION(lda, *) :: a - REAL( KIND = C_RP_ ), INTENT( IN ), DIMENSION(ldb, *) :: b - REAL( KIND = C_RP_ ), INTENT( INOUT ), DIMENSION(ldc, *) :: c - CALL DGEMM( ta, tb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc ) - END SUBROUTINE spral_c_gemm - - SUBROUTINE spral_c_potrf( uplo, n, a, lda, info ) BIND( C ) - USE GALAHAD_KINDS_precision, only: C_IP_, C_RP_ - CHARACTER( C_CHAR ), INTENT( IN ) :: uplo - INTEGER( KIND = C_IP_ ), INTENT( IN ) :: n, lda - INTEGER( KIND = C_IP_ ), INTENT( OUT ) :: info - REAL( KIND = C_RP_ ), INTENT( INOUT ), DIMENSION(lda, *) :: a - CALL DPOTRF(uplo, n, a, lda, info) - END SUBROUTINE spral_c_potrf - - SUBROUTINE spral_c_sytrf( uplo, n, a, lda, ipiv, work, & - lwork, info ) BIND( C ) - USE GALAHAD_KINDS_precision, ONLY: C_IP_, C_RP_ - CHARACTER( C_CHAR ), INTENT( IN ) :: uplo - INTEGER( KIND = C_IP_ ), INTENT( IN ) :: n, lda, lwork - INTEGER( KIND = C_IP_ ), INTENT( OUT ), DIMENSION(n) :: ipiv - INTEGER( KIND = C_IP_ ), INTENT( OUT ) :: info - REAL( KIND = C_RP_ ), INTENT( INOUT ), DIMENSION(lda, *) :: a - REAL( KIND = C_RP_ ), INTENT( OUT ), DIMENSION(*) :: work - CALL DSYTRF( uplo, n, a, lda, ipiv, work, lwork, info ) - END SUBROUTINE spral_c_sytrf - - SUBROUTINE spral_c_trsm( side, uplo, transa, diag, m, n, alpha, a, lda, b, & - ldb ) BIND( C ) - USE GALAHAD_KINDS_precision, ONLY: C_IP_, C_RP_ - CHARACTER( C_CHAR ), INTENT( IN ) :: side, uplo, transa, diag - INTEGER( KIND = C_IP_ ), INTENT( IN ) :: m, n, lda, ldb - REAL( KIND = C_RP_ ), INTENT( IN ) :: alpha - REAL( KIND = C_RP_ ), INTENT( IN ) :: a(lda, *) - REAL( KIND = C_RP_ ), INTENT( INOUT ) :: b(ldb, n) - CALL DTRSM( side, uplo, transa, diag, m, n, alpha, a, lda, b, ldb ) - END SUBROUTINE spral_c_trsm - - SUBROUTINE spral_c_syrk( uplo, trans, n, k, alpha, a, lda, beta, & - c, ldc ) BIND(C) - USE GALAHAD_KINDS_precision, ONLY: C_IP_, C_RP_ - CHARACTER( C_CHAR ), INTENT( IN ) :: uplo, trans - INTEGER( KIND = C_IP_ ), INTENT( IN ) :: n, k, lda, ldc - REAL( KIND = C_RP_ ), INTENT( IN ) :: alpha, beta - REAL( KIND = C_RP_ ), INTENT( IN ), DIMENSION( lda, * ) :: a - REAL( KIND = C_RP_ ), INTENT( INOUT ), DIMENSION( ldc, n ) :: c - CALL DSYRK( uplo, trans, n, k, alpha, a, lda, beta, c, ldc ) - END SUBROUTINE spral_c_syrk - - SUBROUTINE spral_c_trsv( uplo, trans, diag, n, a, lda, x, incx ) BIND( C ) - USE GALAHAD_KINDS_precision, ONLY: C_IP_, C_RP_ - character(C_CHAR), INTENT( IN ) :: uplo, trans, diag - INTEGER( KIND = C_IP_ ), INTENT( IN ) :: n, lda, incx - REAL( KIND = C_RP_ ), INTENT( IN ), DIMENSION(lda, n) :: a - REAL( KIND = C_RP_ ), INTENT( INOUT ), DIMENSION(*) :: x - call DTRSV( uplo, trans, diag, n, a, lda, x, incx ) - END SUBROUTINE spral_c_trsv - - subroutine spral_c_gemv( trans, m, n, alpha, a, lda, x, incx, beta, & - y, incy ) BIND( C ) - use GALAHAD_KINDS_precision, only: C_IP_, C_RP_ - CHARACTER( C_CHAR ), INTENT( IN ) :: trans - INTEGER( KIND = C_IP_ ), INTENT( IN ) :: m, n, lda, incx, incy - REAL( KIND = C_RP_ ), INTENT( IN ) :: alpha, beta - REAL( KIND = C_RP_ ), INTENT( IN ), DIMENSION(lda, n) :: a - REAL( KIND = C_RP_ ), INTENT( IN ), DIMENSION(*) :: x - REAL( KIND = C_RP_ ), INTENT( INOUT ), DIMENSION(*) :: y - CALL DGEMV( trans, m, n, alpha, a, lda, x, incx, beta, y, incy ) - END SUBROUTINE spral_c_gemv - - END MODULE GALAHAD_SSIDS_cpu_iface_precision - diff --git a/src/ssids/cpu_subtree.F90 b/src/ssids/cpu_subtree.F90 deleted file mode 100644 index 80d4e2866a..0000000000 --- a/src/ssids/cpu_subtree.F90 +++ /dev/null @@ -1,1211 +0,0 @@ -! THIS VERSION: GALAHAD 5.3 - 2025-08-31 AT 09:50 GMT - -#include "galahad_modules.h" - -! COPYRIGHT (c) 2016 The Science and Technology Facilities Council (STFC) -! licence: BSD licence, see LICENCE file for details -! author: Jonathan Hogg -! Forked and extended for GALAHAD, Nick Gould, version 3.1, 2016 - - MODULE GALAHAD_SSIDS_cpu_subtree_precision - USE GALAHAD_KINDS_precision - USE GALAHAD_SSIDS_cpu_iface_precision, ONLY: cpu_factor_control, & - cpu_factor_stats, & - cpu_copy_control_in, & - cpu_copy_stats_out - USE GALAHAD_SSIDS_types_precision, ONLY: SSIDS_control_type, & - SSIDS_inform_type, & - SSIDS_SUCCESS, & - SSIDS_ERROR_ALLOCATION, & - contrib_type - USE GALAHAD_SSIDS_subtree_precision, ONLY : symbolic_subtree_base, & - numeric_subtree_base - IMPLICIT none - - PRIVATE - PUBLIC :: cpu_symbolic_subtree, construct_cpu_symbolic_subtree - PUBLIC :: cpu_numeric_subtree, cpu_free_contrib - - TYPE, EXTENDS( symbolic_subtree_base ) :: cpu_symbolic_subtree - INTEGER( KIND = ip_ ) :: n - type( C_PTR ) :: csubtree - CONTAINS - PROCEDURE :: factor - PROCEDURE :: cleanup => symbolic_cleanup - END type cpu_symbolic_subtree - - TYPE, EXTENDS( numeric_subtree_base ) :: cpu_numeric_subtree - LOGICAL( C_BOOL ) :: posdef - TYPE( cpu_symbolic_subtree ), POINTER :: symbolic - TYPE( C_PTR ) :: csubtree - CONTAINS - PROCEDURE :: get_contrib - PROCEDURE :: solve_fwd - PROCEDURE :: solve_diag - PROCEDURE :: solve_diag_bwd - PROCEDURE :: solve_bwd - PROCEDURE :: enquire_posdef - PROCEDURE :: enquire_indef - PROCEDURE :: alter - PROCEDURE :: cleanup => numeric_cleanup - END TYPE cpu_numeric_subtree - -#ifdef INTEGER_64 -#ifdef REAL_32 - INTERFACE - TYPE( C_PTR ) FUNCTION c_create_symbolic_subtree( n, sa, en, sptr, & - sparent, rptr, rlist, nptr, nlist, ncontrib, contrib_idx, control ) & - BIND( C, NAME = "galahad_ssids_cpu_create_symbolic_subtree_sgl_64" ) - USE GALAHAD_KINDS - IMPORT :: cpu_factor_control - IMPLICIT none - INTEGER( KIND = C_IP_ ), VALUE :: n - INTEGER( KIND = C_IP_ ), VALUE :: sa - INTEGER( KIND = C_IP_ ), VALUE :: en - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: sptr - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: sparent - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: rptr - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: rlist - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: nptr - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: nlist - INTEGER( KIND = C_IP_ ), VALUE :: ncontrib - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: contrib_idx - TYPE( cpu_factor_control ), INTENT( IN ) :: control - END FUNCTION c_create_symbolic_subtree - - SUBROUTINE c_destroy_symbolic_subtree( subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_destroy_symbolic_subtree_sgl_64" ) - USE GALAHAD_KINDS - IMPLICIT none - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_destroy_symbolic_subtree - - TYPE( C_PTR ) FUNCTION c_create_numeric_subtree( posdef, & - symbolic_subtree, aval, scaling, child_contrib, control, stats ) & - BIND( C, NAME = "galahad_ssids_cpu_create_num_subtree_sgl_64" ) - USE GALAHAD_KINDS_precision - IMPORT :: cpu_factor_control, cpu_factor_stats - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: symbolic_subtree - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( IN ) :: aval - TYPE( C_PTR ), VALUE :: scaling - TYPE( C_PTR ), DIMENSION( * ), INTENT( INOUT ) :: child_contrib - TYPE( cpu_factor_control ), INTENT( IN ) :: control - TYPE( cpu_factor_stats ), INTENT( OUT ) :: stats - END FUNCTION c_create_numeric_subtree - - SUBROUTINE c_destroy_numeric_subtree( posdef, subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_destroy_num_subtree_sgl_64" ) - USE GALAHAD_KINDS - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_destroy_numeric_subtree - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_fwd( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_fwd_sgl_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_fwd - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_diag( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_diag_sgl_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_diag - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_diag_bwd( posdef, & - subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_diag_bwd_sgl_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_diag_bwd - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_bwd( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_bwd_sgl_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_bwd - - SUBROUTINE c_subtree_enquire( posdef, subtree, piv_order, d ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_enquire_sgl_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - TYPE( C_PTR ), VALUE :: piv_order - TYPE( C_PTR ), VALUE :: d - END SUBROUTINE c_subtree_enquire - - SUBROUTINE c_subtree_alter( posdef, subtree, d ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_alter_sgl_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( IN ) :: d - END SUBROUTINE c_subtree_alter - - SUBROUTINE c_get_contrib( posdef, subtree, n, val, ldval, rlist, ndelay, & - delay_perm, delay_val, lddelay ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_get_contrib_sgl_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ) :: n - TYPE( C_PTR ) :: val - INTEGER( KIND = C_IP_ ) :: ldval - TYPE( C_PTR ) :: rlist - INTEGER( KIND = C_IP_ ) :: ndelay - TYPE( C_PTR ) :: delay_perm - TYPE( C_PTR ) :: delay_val - INTEGER( KIND = C_IP_ ) :: lddelay - END SUBROUTINE c_get_contrib - - SUBROUTINE c_free_contrib( posdef, subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_free_contrib_sgl_64" ) - USE GALAHAD_KINDS - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_free_contrib - END INTERFACE - -#elif REAL_128 - INTERFACE - TYPE( C_PTR ) FUNCTION c_create_symbolic_subtree( n, sa, en, sptr, & - sparent, rptr, rlist, nptr, nlist, ncontrib, contrib_idx, control ) & - BIND( C, NAME = "galahad_ssids_cpu_create_symbolic_subtree_qul_64" ) - USE GALAHAD_KINDS - IMPORT :: cpu_factor_control - IMPLICIT none - INTEGER( KIND = C_IP_ ), VALUE :: n - INTEGER( KIND = C_IP_ ), VALUE :: sa - INTEGER( KIND = C_IP_ ), VALUE :: en - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: sptr - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: sparent - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: rptr - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: rlist - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: nptr - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: nlist - INTEGER( KIND = C_IP_ ), VALUE :: ncontrib - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: contrib_idx - TYPE( cpu_factor_control ), INTENT( IN ) :: control - END FUNCTION c_create_symbolic_subtree - - SUBROUTINE c_destroy_symbolic_subtree( subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_destroy_symbolic_subtree_qul_64" ) - USE GALAHAD_KINDS - IMPLICIT none - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_destroy_symbolic_subtree - - TYPE( C_PTR ) FUNCTION c_create_numeric_subtree( posdef, & - symbolic_subtree, aval, scaling, child_contrib, control, stats ) & - BIND( C, NAME = "galahad_ssids_cpu_create_num_subtree_qul_64" ) - USE GALAHAD_KINDS_precision - IMPORT :: cpu_factor_control, cpu_factor_stats - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: symbolic_subtree - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( IN ) :: aval - TYPE( C_PTR ), VALUE :: scaling - TYPE( C_PTR ), DIMENSION( * ), INTENT( INOUT ) :: child_contrib - TYPE( cpu_factor_control ), INTENT( IN ) :: control - TYPE( cpu_factor_stats ), INTENT( OUT ) :: stats - END FUNCTION c_create_numeric_subtree - - SUBROUTINE c_destroy_numeric_subtree( posdef, subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_destroy_num_subtree_qul_64" ) - USE GALAHAD_KINDS - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_destroy_numeric_subtree - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_fwd( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_fwd_qul_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_fwd - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_diag( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_diag_qul_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_diag - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_diag_bwd( posdef, & - subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_diag_bwd_qul_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_diag_bwd - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_bwd( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_bwd_qul_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_bwd - - SUBROUTINE c_subtree_enquire( posdef, subtree, piv_order, d ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_enquire_qul_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - TYPE( C_PTR ), VALUE :: piv_order - TYPE( C_PTR ), VALUE :: d - END SUBROUTINE c_subtree_enquire - - SUBROUTINE c_subtree_alter( posdef, subtree, d ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_alter_qul_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( IN ) :: d - END SUBROUTINE c_subtree_alter - - SUBROUTINE c_get_contrib( posdef, subtree, n, val, ldval, rlist, ndelay, & - delay_perm, delay_val, lddelay ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_get_contrib_qul_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ) :: n - TYPE( C_PTR ) :: val - INTEGER( KIND = C_IP_ ) :: ldval - TYPE( C_PTR ) :: rlist - INTEGER( KIND = C_IP_ ) :: ndelay - TYPE( C_PTR ) :: delay_perm - TYPE( C_PTR ) :: delay_val - INTEGER( KIND = C_IP_ ) :: lddelay - END SUBROUTINE c_get_contrib - - SUBROUTINE c_free_contrib( posdef, subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_free_contrib_qul_64" ) - USE GALAHAD_KINDS - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_free_contrib - END INTERFACE - -#else - - INTERFACE - TYPE( C_PTR ) FUNCTION c_create_symbolic_subtree( n, sa, en, sptr, & - sparent, rptr, rlist, nptr, nlist, ncontrib, contrib_idx, control ) & - BIND( C, NAME = "galahad_ssids_cpu_create_symbolic_subtree_dbl_64" ) - USE GALAHAD_KINDS - IMPORT :: cpu_factor_control - IMPLICIT none - INTEGER( KIND = C_IP_ ), VALUE :: n - INTEGER( KIND = C_IP_ ), VALUE :: sa - INTEGER( KIND = C_IP_ ), VALUE :: en - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: sptr - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: sparent - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: rptr - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: rlist - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: nptr - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: nlist - INTEGER( KIND = C_IP_ ), VALUE :: ncontrib - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: contrib_idx - TYPE( cpu_factor_control ), INTENT( IN ) :: control - END FUNCTION c_create_symbolic_subtree - - SUBROUTINE c_destroy_symbolic_subtree( subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_destroy_symbolic_subtree_dbl_64" ) - USE GALAHAD_KINDS - IMPLICIT none - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_destroy_symbolic_subtree - - TYPE( C_PTR ) FUNCTION c_create_numeric_subtree( posdef, & - symbolic_subtree, aval, scaling, child_contrib, control, stats ) & - BIND( C, NAME = "galahad_ssids_cpu_create_num_subtree_dbl_64" ) - USE GALAHAD_KINDS_precision - IMPORT :: cpu_factor_control, cpu_factor_stats - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: symbolic_subtree - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( IN ) :: aval - TYPE( C_PTR ), VALUE :: scaling - TYPE( C_PTR ), DIMENSION( * ), INTENT( INOUT ) :: child_contrib - TYPE( cpu_factor_control ), INTENT( IN ) :: control - TYPE( cpu_factor_stats ), INTENT( OUT ) :: stats - END FUNCTION c_create_numeric_subtree - - SUBROUTINE c_destroy_numeric_subtree( posdef, subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_destroy_num_subtree_dbl_64" ) - USE GALAHAD_KINDS - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_destroy_numeric_subtree - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_fwd( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_fwd_dbl_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_fwd - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_diag( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_diag_dbl_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_diag - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_diag_bwd( posdef, & - subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_diag_bwd_dbl_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_diag_bwd - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_bwd( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_bwd_dbl_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_bwd - - SUBROUTINE c_subtree_enquire( posdef, subtree, piv_order, d ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_enquire_dbl_64" ) - USE GALAHAD_KINDS - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - TYPE( C_PTR ), VALUE :: piv_order - TYPE( C_PTR ), VALUE :: d - END SUBROUTINE c_subtree_enquire - - SUBROUTINE c_subtree_alter( posdef, subtree, d ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_alter_dbl_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( IN ) :: d - END SUBROUTINE c_subtree_alter - - SUBROUTINE c_get_contrib( posdef, subtree, n, val, ldval, rlist, ndelay, & - delay_perm, delay_val, lddelay ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_get_contrib_dbl_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ) :: n - TYPE( C_PTR ) :: val - INTEGER( KIND = C_IP_ ) :: ldval - TYPE( C_PTR ) :: rlist - INTEGER( KIND = C_IP_ ) :: ndelay - TYPE( C_PTR ) :: delay_perm - TYPE( C_PTR ) :: delay_val - INTEGER( KIND = C_IP_ ) :: lddelay - END SUBROUTINE c_get_contrib - - SUBROUTINE c_free_contrib( posdef, subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_free_contrib_dbl_64" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_free_contrib - END INTERFACE -#endif -#else -#ifdef REAL_32 - INTERFACE - TYPE( C_PTR ) FUNCTION c_create_symbolic_subtree( n, sa, en, sptr, & - sparent, rptr, rlist, nptr, nlist, ncontrib, contrib_idx, control ) & - BIND( C, NAME = "galahad_ssids_cpu_create_symbolic_subtree_sgl" ) - USE GALAHAD_KINDS - IMPORT :: cpu_factor_control - IMPLICIT none - INTEGER( KIND = C_IP_ ), VALUE :: n - INTEGER( KIND = C_IP_ ), VALUE :: sa - INTEGER( KIND = C_IP_ ), VALUE :: en - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: sptr - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: sparent - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: rptr - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: rlist - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: nptr - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: nlist - INTEGER( KIND = C_IP_ ), VALUE :: ncontrib - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: contrib_idx - TYPE( cpu_factor_control ), INTENT( IN ) :: control - END FUNCTION c_create_symbolic_subtree - - SUBROUTINE c_destroy_symbolic_subtree( subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_destroy_symbolic_subtree_sgl" ) - USE GALAHAD_KINDS - IMPLICIT none - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_destroy_symbolic_subtree - - TYPE( C_PTR ) FUNCTION c_create_numeric_subtree( posdef, & - symbolic_subtree, aval, scaling, child_contrib, control, stats ) & - BIND( C, NAME = "galahad_ssids_cpu_create_num_subtree_sgl" ) - USE GALAHAD_KINDS_precision - IMPORT :: cpu_factor_control, cpu_factor_stats - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: symbolic_subtree - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( IN ) :: aval - TYPE( C_PTR ), VALUE :: scaling - TYPE( C_PTR ), DIMENSION( * ), INTENT( INOUT ) :: child_contrib - TYPE( cpu_factor_control ), INTENT( IN ) :: control - TYPE( cpu_factor_stats ), INTENT( OUT ) :: stats - END FUNCTION c_create_numeric_subtree - - SUBROUTINE c_destroy_numeric_subtree( posdef, subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_destroy_num_subtree_sgl" ) - USE GALAHAD_KINDS - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_destroy_numeric_subtree - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_fwd( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_fwd_sgl" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_fwd - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_diag( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_diag_sgl" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_diag - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_diag_bwd( posdef, & - subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_diag_bwd_sgl" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_diag_bwd - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_bwd( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_bwd_sgl" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_bwd - - SUBROUTINE c_subtree_enquire( posdef, subtree, piv_order, d ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_enquire_sgl" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - TYPE( C_PTR ), VALUE :: piv_order - TYPE( C_PTR ), VALUE :: d - END SUBROUTINE c_subtree_enquire - - SUBROUTINE c_subtree_alter( posdef, subtree, d ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_alter_sgl" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( IN ) :: d - END SUBROUTINE c_subtree_alter - - SUBROUTINE c_get_contrib( posdef, subtree, n, val, ldval, rlist, ndelay, & - delay_perm, delay_val, lddelay ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_get_contrib_sgl" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ) :: n - TYPE( C_PTR ) :: val - INTEGER( KIND = C_IP_ ) :: ldval - TYPE( C_PTR ) :: rlist - INTEGER( KIND = C_IP_ ) :: ndelay - TYPE( C_PTR ) :: delay_perm - TYPE( C_PTR ) :: delay_val - INTEGER( KIND = C_IP_ ) :: lddelay - END SUBROUTINE c_get_contrib - - SUBROUTINE c_free_contrib( posdef, subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_free_contrib_sgl" ) - USE GALAHAD_KINDS - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_free_contrib - END INTERFACE - -#elif REAL_128 - INTERFACE - TYPE( C_PTR ) FUNCTION c_create_symbolic_subtree( n, sa, en, sptr, & - sparent, rptr, rlist, nptr, nlist, ncontrib, contrib_idx, control ) & - BIND( C, NAME = "galahad_ssids_cpu_create_symbolic_subtree_qul" ) - USE GALAHAD_KINDS - IMPORT :: cpu_factor_control - IMPLICIT none - INTEGER( KIND = C_IP_ ), VALUE :: n - INTEGER( KIND = C_IP_ ), VALUE :: sa - INTEGER( KIND = C_IP_ ), VALUE :: en - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: sptr - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: sparent - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: rptr - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: rlist - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: nptr - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: nlist - INTEGER( KIND = C_IP_ ), VALUE :: ncontrib - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: contrib_idx - TYPE( cpu_factor_control ), INTENT( IN ) :: control - END FUNCTION c_create_symbolic_subtree - - SUBROUTINE c_destroy_symbolic_subtree( subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_destroy_symbolic_subtree_qul" ) - USE GALAHAD_KINDS - IMPLICIT none - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_destroy_symbolic_subtree - - TYPE( C_PTR ) FUNCTION c_create_numeric_subtree( posdef, & - symbolic_subtree, aval, scaling, child_contrib, control, stats ) & - BIND( C, NAME = "galahad_ssids_cpu_create_num_subtree_qul" ) - USE GALAHAD_KINDS_precision - IMPORT :: cpu_factor_control, cpu_factor_stats - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: symbolic_subtree - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( IN ) :: aval - TYPE( C_PTR ), VALUE :: scaling - TYPE( C_PTR ), DIMENSION( * ), INTENT( INOUT ) :: child_contrib - TYPE( cpu_factor_control ), INTENT( IN ) :: control - TYPE( cpu_factor_stats ), INTENT( OUT ) :: stats - END FUNCTION c_create_numeric_subtree - - SUBROUTINE c_destroy_numeric_subtree( posdef, subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_destroy_num_subtree_qul" ) - USE GALAHAD_KINDS - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_destroy_numeric_subtree - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_fwd( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_fwd_qul" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_fwd - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_diag( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_diag_qul" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_diag - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_diag_bwd( posdef, & - subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_diag_bwd_qul" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_diag_bwd - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_bwd( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_bwd_qul" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_bwd - - SUBROUTINE c_subtree_enquire( posdef, subtree, piv_order, d ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_enquire_qul" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - TYPE( C_PTR ), VALUE :: piv_order - TYPE( C_PTR ), VALUE :: d - END SUBROUTINE c_subtree_enquire - - SUBROUTINE c_subtree_alter( posdef, subtree, d ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_alter_qul" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( IN ) :: d - END SUBROUTINE c_subtree_alter - - SUBROUTINE c_get_contrib( posdef, subtree, n, val, ldval, rlist, ndelay, & - delay_perm, delay_val, lddelay ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_get_contrib_qul" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ) :: n - TYPE( C_PTR ) :: val - INTEGER( KIND = C_IP_ ) :: ldval - TYPE( C_PTR ) :: rlist - INTEGER( KIND = C_IP_ ) :: ndelay - TYPE( C_PTR ) :: delay_perm - TYPE( C_PTR ) :: delay_val - INTEGER( KIND = C_IP_ ) :: lddelay - END SUBROUTINE c_get_contrib - - SUBROUTINE c_free_contrib( posdef, subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_free_contrib_qul" ) - USE GALAHAD_KINDS - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_free_contrib - END INTERFACE - -#else - - INTERFACE - TYPE( C_PTR ) FUNCTION c_create_symbolic_subtree( n, sa, en, sptr, & - sparent, rptr, rlist, nptr, nlist, ncontrib, contrib_idx, control ) & - BIND( C, NAME = "galahad_ssids_cpu_create_symbolic_subtree_dbl" ) - USE GALAHAD_KINDS - IMPORT :: cpu_factor_control - IMPLICIT none - INTEGER( KIND = C_IP_ ), VALUE :: n - INTEGER( KIND = C_IP_ ), VALUE :: sa - INTEGER( KIND = C_IP_ ), VALUE :: en - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: sptr - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: sparent - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: rptr - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: rlist - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: nptr - INTEGER( KIND = CLONG_ ), DIMENSION( * ), INTENT( IN ) :: nlist - INTEGER( KIND = C_IP_ ), VALUE :: ncontrib - INTEGER( KIND = C_IP_ ), DIMENSION( * ), INTENT( IN ) :: contrib_idx - TYPE( cpu_factor_control ), INTENT( IN ) :: control - END FUNCTION c_create_symbolic_subtree - - SUBROUTINE c_destroy_symbolic_subtree( subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_destroy_symbolic_subtree_dbl" ) - USE GALAHAD_KINDS - IMPLICIT none - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_destroy_symbolic_subtree - - TYPE( C_PTR ) FUNCTION c_create_numeric_subtree( posdef, & - symbolic_subtree, aval, scaling, child_contrib, control, stats ) & - BIND( C, NAME = "galahad_ssids_cpu_create_num_subtree_dbl" ) - USE GALAHAD_KINDS_precision - IMPORT :: cpu_factor_control, cpu_factor_stats - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: symbolic_subtree - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( IN ) :: aval - TYPE( C_PTR ), VALUE :: scaling - TYPE( C_PTR ), DIMENSION( * ), INTENT( INOUT ) :: child_contrib - TYPE( cpu_factor_control ), INTENT( IN ) :: control - TYPE( cpu_factor_stats ), INTENT( OUT ) :: stats - END FUNCTION c_create_numeric_subtree - - SUBROUTINE c_destroy_numeric_subtree( posdef, subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_destroy_num_subtree_dbl" ) - USE GALAHAD_KINDS - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_destroy_numeric_subtree - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_fwd( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_fwd_dbl" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_fwd - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_diag( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_diag_dbl" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_diag - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_diag_bwd( posdef, & - subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_diag_bwd_dbl" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_diag_bwd - - INTEGER( KIND = C_IP_ ) FUNCTION c_subtree_solve_bwd( posdef, subtree, & - nrhs, x, ldx ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_solve_bwd_dbl" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ), VALUE :: nrhs - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = C_IP_ ), VALUE :: ldx - END FUNCTION c_subtree_solve_bwd - - SUBROUTINE c_subtree_enquire( posdef, subtree, piv_order, d ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_enquire_dbl" ) - USE GALAHAD_KINDS - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - TYPE( C_PTR ), VALUE :: piv_order - TYPE( C_PTR ), VALUE :: d - END SUBROUTINE c_subtree_enquire - - SUBROUTINE c_subtree_alter( posdef, subtree, d ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_alter_dbl" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - REAL( KIND = C_RP_ ), DIMENSION( * ), INTENT( IN ) :: d - END SUBROUTINE c_subtree_alter - - SUBROUTINE c_get_contrib( posdef, subtree, n, val, ldval, rlist, ndelay, & - delay_perm, delay_val, lddelay ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_get_contrib_dbl" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - INTEGER( KIND = C_IP_ ) :: n - TYPE( C_PTR ) :: val - INTEGER( KIND = C_IP_ ) :: ldval - TYPE( C_PTR ) :: rlist - INTEGER( KIND = C_IP_ ) :: ndelay - TYPE( C_PTR ) :: delay_perm - TYPE( C_PTR ) :: delay_val - INTEGER( KIND = C_IP_ ) :: lddelay - END SUBROUTINE c_get_contrib - - SUBROUTINE c_free_contrib( posdef, subtree ) & - BIND( C, NAME = "galahad_ssids_cpu_subtree_free_contrib_dbl" ) - USE GALAHAD_KINDS_precision - IMPLICIT none - LOGICAL( C_BOOL ), VALUE :: posdef - TYPE( C_PTR ), VALUE :: subtree - END SUBROUTINE c_free_contrib - END INTERFACE -#endif -#endif - - CONTAINS - - FUNCTION construct_cpu_symbolic_subtree( n, sa, en, sptr, sparent, rptr, & - rlist, nptr, nlist, contrib_idx, control ) RESULT( this ) - IMPLICIT none - CLASS( cpu_symbolic_subtree ), POINTER :: this - INTEGER( KIND = ip_ ), INTENT( IN ) :: n - INTEGER( KIND = ip_ ), INTENT( IN ) :: sa - INTEGER( KIND = ip_ ), INTENT( IN ) :: en - INTEGER( KIND = ip_ ), DIMENSION( * ), TARGET, INTENT( IN ) :: sptr - INTEGER( KIND = ip_ ), DIMENSION( * ), INTENT( IN ) :: sparent - INTEGER( KIND = long_ ), DIMENSION( * ), TARGET, INTENT( IN ) :: rptr - INTEGER( KIND = ip_ ), DIMENSION( * ), TARGET, INTENT( IN ) :: rlist - INTEGER( KIND = long_ ), DIMENSION( * ), TARGET, INTENT( IN ) :: nptr - INTEGER( KIND = long_ ), DIMENSION( 2,* ), TARGET, INTENT( IN ) :: nlist - INTEGER( KIND = ip_ ), DIMENSION( : ), INTENT( IN ) :: contrib_idx - CLASS( ssids_control_type ), INTENT( IN ) :: control - - INTEGER( KIND = ip_ ) :: st - TYPE( cpu_factor_control ) :: ccontrol - - NULLIFY( this ) - -! allocate output - - ALLOCATE( this, STAT = st ) - IF ( st /= 0 ) RETURN - -! store basic details - - this%n = n - -! call C++ subtree analyse - - CALL cpu_copy_control_in( control, ccontrol ) - this%csubtree = & - c_create_symbolic_subtree( n, sa, en, sptr, sparent, rptr, rlist, & - nptr, nlist, INT( SIZE( contrib_idx ), ip_ ), & - contrib_idx, ccontrol ) - RETURN - - END FUNCTION construct_cpu_symbolic_subtree - - SUBROUTINE symbolic_cleanup( this ) - IMPLICIT none - CLASS( cpu_symbolic_subtree ), INTENT( INOUT ) :: this - - CALL c_destroy_symbolic_subtree( this%csubtree ) - END SUBROUTINE symbolic_cleanup - - FUNCTION factor( this, posdef, aval, child_contrib, control, inform, & - scaling ) - IMPLICIT none - CLASS( numeric_subtree_base ), POINTER :: factor - CLASS( cpu_symbolic_subtree ), TARGET, INTENT( INOUT ) :: this - LOGICAL, INTENT( IN ) :: posdef - REAL( KIND = rp_ ), DIMENSION( * ), TARGET, INTENT( IN ) :: aval - TYPE( contrib_type ), DIMENSION( : ), TARGET, & - INTENT( INOUT ) :: child_contrib - TYPE( ssids_control_type ), INTENT( IN ) :: control - TYPE( ssids_inform_type ), INTENT( INOUT ) :: inform - REAL( KIND = rp_ ), DIMENSION( * ), TARGET, OPTIONAL, & - INTENT( IN ) :: scaling - - TYPE( cpu_numeric_subtree ), POINTER :: cpu_factor - TYPE( cpu_factor_control ) :: ccontrol - TYPE( cpu_factor_stats ) :: cstats - TYPE( C_PTR ) :: cscaling - INTEGER( KIND = ip_ ) :: i - TYPE( C_PTR ), DIMENSION( : ), allocatable :: contrib_ptr - INTEGER( KIND = ip_ ) :: st - -! leave output as null until successful exit - - NULLIFY( factor ) - -! allocate cpu_factor for output - - ALLOCATE( cpu_factor, STAT = st ) - IF ( st /= 0 ) GO TO 10 - cpu_factor%symbolic => this - -! convert child_contrib to contrib_ptr - - ALLOCATE( contrib_ptr( size( child_contrib ) ), STAT = st ) - IF ( st /= 0 ) GO TO 10 - DO i = 1, size( child_contrib ) - contrib_ptr( i ) = C_LOC( child_contrib( i ) ) - END DO - -! call C++ factor routine - - cpu_factor%posdef = posdef - cscaling = C_NULL_PTR - IF ( PRESENT( scaling ) ) cscaling = C_LOC( scaling ) - CALL cpu_copy_control_in( control, ccontrol ) - - cpu_factor%csubtree = & - c_create_numeric_subtree( cpu_factor%posdef, this%csubtree, & - aval, cscaling, contrib_ptr, ccontrol, cstats ) - IF ( cstats%flag < 0 ) THEN - CALL c_destroy_numeric_subtree( cpu_factor%posdef, cpu_factor%csubtree ) - DEALLOCATE( cpu_factor, STAT = st ) - inform%flag = cstats%flag - RETURN - END IF - -! extract to Fortran data structures - - CALL cpu_copy_stats_out( cstats, inform ) - -! success, set result and return - - factor => cpu_factor - RETURN - -! allocation error handler -10 CONTINUE - inform%flag = SSIDS_ERROR_ALLOCATION - inform%stat = st - DEALLOCATE( cpu_factor, STAT = st ) - RETURN - - END FUNCTION factor - - SUBROUTINE numeric_cleanup( this ) - IMPLICIT none - CLASS( cpu_numeric_subtree ), INTENT( INOUT ) :: this - - CALL c_destroy_numeric_subtree( this%posdef, this%csubtree ) - END SUBROUTINE numeric_cleanup - - FUNCTION get_contrib( this ) - IMPLICIT none - TYPE( contrib_type ) :: get_contrib - CLASS( cpu_numeric_subtree ), INTENT( IN ) :: this - - TYPE( C_PTR ) :: cval, crlist, delay_perm, delay_val - - CALL c_get_contrib( this%posdef, this%csubtree, get_contrib%n, cval, & - get_contrib%ldval, crlist, get_contrib%ndelay, delay_perm, delay_val, & - get_contrib%lddelay ) - CALL c_f_pointer( cval, get_contrib%val, shape = (/ get_contrib%n ** 2 /) ) - CALL c_f_pointer( crlist, get_contrib%rlist, shape = (/ get_contrib%n /) ) - IF ( c_associated( delay_val ) ) THEN - CALL c_f_pointer( delay_perm, get_contrib%delay_perm, & - shape = (/ get_contrib%ndelay /) ) - CALL c_f_pointer( delay_val, get_contrib%delay_val, & - shape = (/ get_contrib%ndelay*get_contrib%lddelay /) ) - ELSE - NULLIFY( get_contrib%delay_perm ) - NULLIFY( get_contrib%delay_val ) - END IF - get_contrib%owner = 0 ! cpu - get_contrib%posdef = this%posdef - get_contrib%owner_ptr = this%csubtree - END FUNCTION get_contrib - - SUBROUTINE solve_fwd( this, nrhs, x, ldx, inform ) - IMPLICIT none - CLASS( cpu_numeric_subtree ), INTENT( INOUT ) :: this - INTEGER( KIND = ip_ ), INTENT( IN ) :: nrhs - REAL( KIND = rp_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = ip_ ), INTENT( IN ) :: ldx - TYPE( ssids_inform_type ), INTENT( INOUT ) :: inform - - INTEGER( KIND = C_IP_ ) :: flag - - flag = c_subtree_solve_fwd( this%posdef, this%csubtree, nrhs, x, ldx ) - IF ( flag /= SSIDS_SUCCESS ) inform%flag = flag - RETURN - - END SUBROUTINE solve_fwd - - SUBROUTINE solve_diag( this, nrhs, x, ldx, inform ) - IMPLICIT none - CLASS( cpu_numeric_subtree ), INTENT( INOUT ) :: this - INTEGER( KIND = ip_ ), INTENT( IN ) :: nrhs - REAL( KIND = rp_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = ip_ ), INTENT( IN ) :: ldx - TYPE( ssids_inform_type ), INTENT( INOUT ) :: inform - - INTEGER( KIND = C_IP_ ) :: flag - - flag = c_subtree_solve_diag( this%posdef, this%csubtree, nrhs, x, ldx ) - IF ( flag /= SSIDS_SUCCESS ) inform%flag = flag - RETURN - - END SUBROUTINE solve_diag - - SUBROUTINE solve_diag_bwd( this, nrhs, x, ldx, inform ) - IMPLICIT none - CLASS( cpu_numeric_subtree ), INTENT( INOUT ) :: this - INTEGER( KIND = ip_ ), INTENT( IN ) :: nrhs - REAL( KIND = rp_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = ip_ ), INTENT( IN ) :: ldx - TYPE( ssids_inform_type ), INTENT( INOUT ) :: inform - - INTEGER( KIND = C_IP_ ) :: flag - - flag = c_subtree_solve_diag_bwd( this%posdef, this%csubtree, nrhs, x, ldx ) - IF ( flag /= SSIDS_SUCCESS ) inform%flag = flag - RETURN - - END SUBROUTINE solve_diag_bwd - - SUBROUTINE solve_bwd( this, nrhs, x, ldx, inform ) - IMPLICIT none - CLASS( cpu_numeric_subtree ), INTENT( INOUT ) :: this - INTEGER( KIND = ip_ ), INTENT( IN ) :: nrhs - REAL( KIND = rp_ ), DIMENSION( * ), INTENT( INOUT ) :: x - INTEGER( KIND = ip_ ), INTENT( IN ) :: ldx - TYPE( ssids_inform_type ), INTENT( INOUT ) :: inform - - INTEGER( KIND = C_IP_ ) :: flag - - flag = c_subtree_solve_bwd( this%posdef, this%csubtree, nrhs, x, ldx ) - IF ( flag /= SSIDS_SUCCESS ) inform%flag = flag - RETURN - - END SUBROUTINE solve_bwd - - SUBROUTINE enquire_posdef( this, d ) - IMPLICIT none - CLASS( cpu_numeric_subtree ), INTENT( IN ) :: this - REAL( KIND = rp_ ), DIMENSION( * ), TARGET, INTENT( OUT ) :: d - - CALL c_subtree_enquire( this%posdef, this%csubtree, C_NULL_PTR, C_LOC( d ) ) - RETURN - - END SUBROUTINE enquire_posdef - - SUBROUTINE enquire_indef( this, piv_order, d ) - IMPLICIT none - CLASS( cpu_numeric_subtree ), INTENT( IN ) :: this - INTEGER( KIND = ip_ ), DIMENSION( * ), TARGET, OPTIONAL, & - INTENT( OUT ) :: piv_order - REAL( KIND = rp_ ), DIMENSION( 2,* ), TARGET, OPTIONAL, & - INTENT( OUT ) :: d - - TYPE( C_PTR ) :: dptr, poptr - -! setup pointers - - poptr = C_NULL_PTR - IF ( PRESENT( piv_order ) ) poptr = C_LOC( piv_order ) - dptr = C_NULL_PTR - IF ( present( d ) ) dptr = C_LOC( d ) - -! call C++ routine - - CALL c_subtree_enquire( this%posdef, this%csubtree, poptr, dptr ) - RETURN - - END SUBROUTINE enquire_indef - - SUBROUTINE alter( this, d ) - IMPLICIT none - CLASS( cpu_numeric_subtree ), TARGET, INTENT( INOUT ) :: this - REAL( KIND = rp_ ), DIMENSION( 2, * ), INTENT( IN ) :: d - - CALL c_subtree_alter( this%posdef, this%csubtree, d ) - RETURN - - END SUBROUTINE alter - - SUBROUTINE cpu_free_contrib( posdef, csubtree ) - IMPLICIT none - LOGICAL( C_BOOL ), INTENT( IN ) :: posdef - TYPE( C_PTR ), INTENT( INOUT ) :: csubtree - - CALL c_free_contrib( posdef, csubtree ) - RETURN - - END SUBROUTINE cpu_free_contrib - - END MODULE GALAHAD_SSIDS_cpu_subtree_precision diff --git a/src/ssids/ldlt_app.cxx b/src/ssids/ldlt_app.cxx deleted file mode 100644 index 0ccec1f75c..0000000000 --- a/src/ssids/ldlt_app.cxx +++ /dev/null @@ -1,2589 +0,0 @@ -/** \file \copyright 2016 The Science and Technology Facilities Council - * (STFC) \licence BSD licence, see LICENCE file for details \author - * Jonathan Hogg - * Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 09:00 GMT - */ -#include "ssids_cpu_kernels_ldlt_app.hxx" - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#ifdef _OPENMP -#include -#endif /* _OPENMP */ - -#include "galahad_modules.h" -#include "ssids_compat.hxx" -#include "ssids_routines.h" -#include "ssids_cpu_BlockPool.hxx" -#include "ssids_cpu_BuddyAllocator.hxx" -#include "ssids_cpu_cpu_iface.hxx" -#include "ssids_cpu_Workspace.hxx" -#include "ssids_cpu_kernels_block_ldlt.hxx" -#include "ssids_cpu_kernels_calc_ld.hxx" -#include "ssids_cpu_kernels_ldlt_tpp.hxx" -#include "ssids_cpu_kernels_common.hxx" -#include "ssids_cpu_kernels_wrappers.hxx" - -namespace galahad { namespace ssids { namespace cpu { - -namespace ldlt_app_internal { - -static const ipc_ INNER_BLOCK_SIZE = 32; - -/** \return number of blocks for given n */ -inline ipc_ calc_nblk(ipc_ n, ipc_ block_size) { - return (n-1) / block_size + 1; -} - -/** \return block size of block blk if maximum in dimension is n */ -inline ipc_ calc_blkn(ipc_ blk, ipc_ n, ipc_ block_size) { - return std::min(block_size, n-blk*block_size); -} - -/** \brief Data about block column of factorization; handles operations - * concerning number of eliminated variables and stores D. - * \tparam T underlying data type, e.g. double - */ -template -class Column { -public: - bool first_elim; ///< True if first column with eliminations - ipc_ nelim; ///< Number of eliminated entries in this column - T *d; ///< Pointer to local d - - // \{ - Column(Column const&) =delete; // must be unique - Column& operator=(Column const&) =delete; // must be unique - Column() =default; - // \} - - /** \brief Initialize number of passed columns ready for reduction - * \param passed number of variables passing a posteori pivot test in block - */ - void init_passed(ipc_ passed) { - galahad::omp::AcquiredLock scopeLock(lock_); - npass_ = passed; - } - /** \brief Update number of passed columns. - * \details Aquires a lock before doing a minimum reduction across blocks - * \param passed number of variables passing a posteori pivot test in block - */ - void update_passed(ipc_ passed) { - galahad::omp::AcquiredLock scopeLock(lock_); - npass_ = std::min(npass_, passed); - } - /** \brief Test if column has failed (in unpivoted case), recording number of - * blocks in column that have passed. To be called once per block - * in the column. - * \details Whilst this check could easily be done without calling this - * routine, the atomic recording of number that have passed would - * not be done, and this is essential for calculating number of - * sucessful columns in the case of a global cancellation. - * \param passed number of pivots that succeeded for a block - * \returns true if passed < nelim */ - bool test_fail(ipc_ passed) { - bool fail = (passed < nelim); - if(!fail) { - // Record number of blocks in column passing this test - galahad::omp::AcquiredLock scopeLock(lock_); - ++npass_; - } - return fail; - } - - /** \brief Adjust nelim after all blocks of row/column have completed to - * avoid split 2x2 pivots. Also updates next_elim. - * \details If a split 2x2 pivot is detected, the number of eliminated - * variables is reduced by one. This routine also sets first_elim - * to true if this is the first column to successfully eliminated - * a variable, and sets nelim for this column. - * \param next_elim global number of eliminated pivots to be updated based - * on number eliminated in this column. */ - void adjust(ipc_& next_elim) { - // Test if last passed column was first part of a 2x2: if so, - // decrement npass - galahad::omp::AcquiredLock scopeLock(lock_); - if(npass_>0) { - T d11 = d[2*(npass_-1)+0]; - T d21 = d[2*(npass_-1)+1]; -#ifdef REAL_128 - if(std::isfinite(static_cast(d11)) && // not second half of 2x2 -#else - if(std::isfinite(d11) && // not second half of 2x2 -#endif - d21 != 0.0) // not a 1x1 or zero pivot - npass_--; // so must be first half 2x2 - } - // Update elimination progress - first_elim = (next_elim==0 && npass_>0); - next_elim += npass_; - nelim = npass_; - } - /** \brief Move entries of permutation for eliminated entries backwards to - * close up space from failed columns, whilst extracting failed - * entries. - * \details n entries of perm are moved to elim_perm (that may overlap - * with perm). Uneliminated variables are placed into failed_perm. - * \param n number of entries in block to be moved to elim_perm or failed. - * \param perm[n] source pointer - * \param elim_perm destination pointer for eliminated columns - * from perm, first nelim entries are filled on output. - * \param failed_perm destination pointer for failed columns from - * perm first (n-nelim) entries are filled on output. - * \internal Note that there is no need to consider a similar operation for - * d[] as it is only used for eliminated variables. - */ - void move_back(ipc_ n, ipc_ const* perm, ipc_* elim_perm, ipc_* failed_perm) { - if(perm != elim_perm) { // Don't move if memory is identical - for(ipc_ i=0; i -class ColumnData { - // \{ - typedef typename std::allocator_traits::template rebind_traits> ColAllocTraits; - typedef typename std::allocator_traits IntAllocTraits; - // \} -public: - // \{ - ColumnData(ColumnData const&) =delete; //not copyable - ColumnData& operator=(ColumnData const&) =delete; //not copyable - // \} - /** \brief Constructor - * \param n number of columns - * \param block_size block size - * \param alloc allocator instance to use for allocation - */ - ColumnData(ipc_ n, ipc_ block_size, IntAlloc const& alloc) - : n_(n), block_size_(block_size), alloc_(alloc) - { - ipc_ nblk = calc_nblk(n_, block_size_); - typename ColAllocTraits::allocator_type colAlloc(alloc_); - cdata_ = ColAllocTraits::allocate(colAlloc, nblk); - for(ipc_ i=0; i& operator[](ipc_ idx) { return cdata_[idx]; } - - /** \brief Return local permutation pointer for given column - * \param blk block column - * \return pointer to local permutation - */ - ipc_* get_lperm(ipc_ blk) { return &lperm_[blk*block_size_]; } - - /** \brief Calculate number of eliminated columns in unpivoted case - * \param m number of rows in matrix - * \return number of sucesfully eliminated columns - */ - ipc_ calc_nelim(ipc_ m) const { - ipc_ mblk = calc_nblk(m, block_size_); - ipc_ nblk = calc_nblk(n_, block_size_); - ipc_ nelim = 0; - for(ipc_ j=0; j *cdata_; ///< underlying array of columns - ipc_* lperm_; ///< underlying local permutation -}; - - -/** Returns true if ptr is suitably aligned for AVX, false if not */ -bool is_aligned(void* ptr) { -#if defined(__AVX512F__) - const ipc_ align = 64; -#elif defined(__AVX__) - const ipc_ align = 32; -#else - const ipc_ align = 16; -#endif - return (reinterpret_cast(ptr) % align == 0); -} - -/** Move up eliminated entries to fill any gaps left by failed pivots - * within diagonal block. - * Note that out and aval may overlap. */ -template -void move_up_diag(Column const& idata, Column const& jdata, T* out, T const* aval, ipc_ lda) { - if(out == aval) return; // don't bother moving if memory is the same - for(ipc_ j=0; j -void move_up_rect(ipc_ m, ipc_ rfrom, Column const& jdata, T* out, T const* aval, ipc_ lda) { - if(out == aval) return; // don't bother moving if memory is the same - for(ipc_ j=0; j -void copy_failed_diag(ipc_ m, ipc_ n, Column const& idata, Column const& jdata, T* rout, T* cout, T* dout, ipc_ ldout, T const* aval, ipc_ lda) { - /* copy rows */ - for(ipc_ j=0; j -void copy_failed_rect(ipc_ m, ipc_ n, ipc_ rfrom, Column const& jdata, T* cout, ipc_ ldout, T const* aval, ipc_ lda) { - for(ipc_ j=jdata.nelim, jout=0; j -ipc_ check_threshold(ipc_ rfrom, ipc_ rto, ipc_ cfrom, ipc_ cto, T u, T* aval, ipc_ lda) { - // Perform threshold test for each uneliminated row/column - ipc_ least_fail = (op==OP_N) ? cto : rto; - for(ipc_ j=cfrom; j 1.0/u) { - if(op==OP_N) { - // must be least failed col - return j; - } else { - // may be an earlier failed row - least_fail = std::min(least_fail, i); - break; - } - } - // If we get this far, everything is good - return least_fail; -} - -/** Performs solve with diagonal block \f$L_{21} = A_{21} L_{11}^{-T} D_1^{-1}\f$. Designed for below diagonal. */ -/* NB: d stores (inverted) pivots as follows: - * 2x2 ( a b ) stored as d = [ a b Inf c ] - * ( b c ) - * 1x1 ( a ) stored as d = [ a 0.0 ] - * 1x1 ( 0 ) stored as d = [ 0.0 0.0 ] - */ -template -void apply_pivot(ipc_ m, ipc_ n, ipc_ from, const T *diag, const T *d, - const T small, T* aval, ipc_ lda) { - if(op==OP_N && from > m) return; // no-op - if(op==OP_T && from > n) return; // no-op - - rpc_ one_val = 1.0; - if(op==OP_N) { - // Perform solve L_11^-T - host_trsm(SIDE_RIGHT, FILL_MODE_LWR, OP_T, DIAG_UNIT, - m, n, one_val, diag, lda, aval, lda); - // Perform solve L_21 D^-1 - for(ipc_ i=0; i(d[2*i+2]))) { -#else - if(i+1==n || std::isfinite(d[2*i+2])) { -#endif - // 1x1 pivot - T d11 = d[2*i]; - if(d11 == 0.0) { - // Handle zero pivots carefully - for(ipc_ j=0; j::infinity()*v; -#endif - // NB: *v above handles NaNs correctly - } - } else { - // Non-zero pivot, apply in normal fashion - for(ipc_ j=0; j(SIDE_LEFT, FILL_MODE_LWR, OP_N, DIAG_UNIT, - m, n-from, one_val, diag, lda, &aval[from*lda], lda); - // Perform solve D^-T L_21^T - for(ipc_ i=0; i(d[2*i+2]))) { -#else - if(i+1==m || std::isfinite(d[2*i+2])) { -#endif - // 1x1 pivot - T d11 = d[2*i]; - if(d11 == 0.0) { - // Handle zero pivots carefully - for(ipc_ j=from; j::infinity()*v; -#endif - // NB: *v above handles NaNs correctly - } - } else { - // Non-zero pivot, apply in normal fashion - for(ipc_ j=from; j> -class CopyBackup { - // \{ - typedef typename std::allocator_traits::template rebind_traits BATraits; - // \} -public: - // \{ - CopyBackup(CopyBackup const&) =delete; - CopyBackup& operator=(CopyBackup const&) =delete; - // \} - /** \brief constructor - * \param m number of rows in matrix - * \param n number of blocks in matrix - * \param block_size dimension of a block in rows or columns - * \param alloc allocator instance to use when allocating memory - */ - CopyBackup(ipc_ m, ipc_ n, ipc_ block_size, Allocator const& alloc=Allocator()) - : alloc_(alloc), m_(m), n_(n), mblk_(calc_nblk(m,block_size)), - block_size_(block_size), ldcopy_(align_lda(m_)), - acopy_(alloc_.allocate(n_*ldcopy_)) - { - typename BATraits::allocator_type boolAlloc(alloc_); - } - ~CopyBackup() { - release_all_memory(); - } - - /** \brief release all associated memory; no further operations permitted. - * \details Storing a complete copy of the matrix is memory intensive, this - * routine is provided to free that storage whilst the instance is - * still in scope, for cases where it cannot otherwise easily be - * reclaimed as soon as required. - */ - void release_all_memory() { - if(acopy_) { - alloc_.deallocate(acopy_, n_*ldcopy_); - acopy_ = nullptr; - } - } - - /** \brief Release memory associated with backup of given block. - * \details Provided for compatability with PoolBackup, this - * routine is a no-op for CopyBackup. - * \param iblk row index of block. - * \param jblk column index of block. - */ - void release(ipc_ iblk, ipc_ jblk) { /* no-op */ } - - /** \brief Create a restore point for the given block. - * \param iblk row index of block. - * \param jblk column index of block. - * \param aval pointer to block to be stored. - * \param lda leading dimension of aval. - */ - void create_restore_point(ipc_ iblk, ipc_ jblk, T const* aval, ipc_ lda) { - T* lwork = get_lwork(iblk, jblk); - for(ipc_ j=0; jc) ? lwork[c*ldcopy_+r] - : lwork[r*ldcopy_+c]; - } - for(ipc_ i=get_ncol(jblk); i> -class PoolBackup { - //! \{ - typedef typename std::allocator_traits::template rebind_alloc TptrAlloc; - //! \} -public: - /** \brief Constructor - * \param m number of rows in matrix - * \param n number of blocks in matrix - * \param block_size dimension of a block in rows or columns - * \param alloc allocator instance to use when allocating memory - */ - // FIXME: reduce pool size - PoolBackup(ipc_ m, ipc_ n, ipc_ block_size, Allocator const& alloc=Allocator()) - : m_(m), n_(n), block_size_(block_size), mblk_(calc_nblk(m,block_size)), - pool_(calc_nblk(n,block_size)*((calc_nblk(n,block_size)+1)/2+mblk_), block_size, alloc), - ptr_(mblk_*calc_nblk(n,block_size), alloc) - {} - - /** \brief Release memory associated with backup of given block. - * \param iblk row index of block. - * \param jblk column index of block. - */ - void release(ipc_ iblk, ipc_ jblk) { - pool_.release(ptr_[jblk*mblk_+iblk]); - ptr_[jblk*mblk_+iblk] = nullptr; - } - - /** \brief Create a restore point for the given block. - * \param iblk row index of block. - * \param jblk column index of block. - * \param aval pointer to block to be stored. - * \param lda leading dimension of aval. - */ - void create_restore_point(ipc_ iblk, ipc_ jblk, T const* aval, ipc_ lda) { - T*& lwork = ptr_[jblk*mblk_+iblk]; - lwork = pool_.get_wait(); - for(ipc_ j=0; jc) ? lwork[c*block_size_+r] - : lwork[r*block_size_+c]; - } - for(ipc_ i=get_ncol(jblk); i pool_; ///< pool of blocks - std::vector ptr_; ///< map from pointer matrix entry to block -}; - -template - > -class LDLT; - -/** \brief Functional wrapper around a block of the underlying matrix. - * \details Provides a light-weight wrapper around blocks of the matrix - * to provide location-aware functionality and thus safety. - * \tparam T Underlying datatype, e.g. double. - * \tparam INNER_BLOCK_SIZE The inner block size to be used for recursion - * decisions in factor(). - * \tparam IntAlloc an allocator for type int used in specification of - * ColumnData type. - */ -template -class Block { -public: - /** \brief Constuctor. - * \param i Block's row index. - * \param j Block's column index. - * \param m Number of rows in matrix. - * \param n Number of columns in matrix. - * \param cdata ColumnData for factorization. - * \param a Pointer to underlying storage of matrix. - * \param lda Leading dimension of a. - * \param block_size The block size. - */ - Block(ipc_ i, ipc_ j, ipc_ m, ipc_ n, ColumnData& cdata, T* a, - ipc_ lda, ipc_ block_size) - : i_(i), j_(j), m_(m), n_(n), lda_(lda), block_size_(block_size), - cdata_(cdata), aval_(&a[j*block_size*lda+i*block_size]) - {} - - /** \brief Create backup of this block. - * \tparam Backup Underlying backup type. - * \param backup Storage containing backup. - */ - template - void backup(Backup& backup) { - backup.create_restore_point(i_, j_, aval_, lda_); - } - - /** \brief Apply column permutation to block and create a backup. - * \tparam Backup Underlying backup type. - * \param backup Storage containing backup. - */ - template - void apply_rperm_and_backup(Backup& backup) { - backup.create_restore_point_with_row_perm( - i_, j_, get_ncol(i_), cdata_.get_lperm(i_), aval_, lda_ - ); - } - - /** \brief Apply row permutation to block. - * \param work Thread-specific workspace. - */ - void apply_rperm(Workspace& work) { - ipc_ ldl = align_lda(block_size_); - T* lwork = work.get_ptr(ncol()*ldl); - ipc_* lperm = cdata_.get_lperm(i_); - // Copy into lwork with permutation - for(ipc_ j=0; j(block_size_); - T* lwork = work.get_ptr(ncol()*ldl); - ipc_* lperm = cdata_.get_lperm(i_); - // Copy into lwork with permutation - for(ipc_ j=0; j - void apply_cperm_and_backup(Backup& backup) { - backup.create_restore_point_with_col_perm( - i_, j_, cdata_.get_lperm(j_), aval_, lda_ - ); - } - - /** \brief Apply column permutation to block. - * \param work Thread-specific workspace. - */ - void apply_cperm(Workspace& work) { - ipc_ ldl = align_lda(block_size_); - T* lwork = work.get_ptr(ncol()*ldl); - ipc_* lperm = cdata_.get_lperm(j_); - // Copy into lwork with permutation - for(ipc_ j=0; j - void full_restore(Backup& backup) { - backup.restore_part(i_, j_, 0, 0, aval_, lda_); - } - - /** \brief Restore any failed columns from backup. - * \details Storage associated with backup is released by this routine - * once we are done with it. This routine should only be called - * for blocks in the eliminated row/column. - * \tparam Backup Underlying backup type. - * \param backup Storage containing backup. - * \param elim_col The block column we've just finished eliminating and - * wish to perform restores associated with. - */ - template - void restore_if_required(Backup& backup, ipc_ elim_col) { - if(i_ == elim_col && j_ == elim_col) { // In eliminated diagonal block - if(cdata_[i_].nelim < ncol()) { // If there are failed pivots - backup.restore_part_with_sym_perm( - i_, j_, cdata_[i_].nelim, cdata_.get_lperm(i_), aval_, lda_ - ); - } - // Release resources regardless, no longer required - backup.release(i_, j_); - } - else if(i_ == elim_col) { // In eliminated row - if(cdata_[i_].nelim < nrow()) // If there are failed pivots - backup.restore_part( - i_, j_, cdata_[i_].nelim, cdata_[j_].nelim, aval_, lda_ - ); - // Release resources regardless, no longer required - backup.release(i_, j_); - } - else if(j_ == elim_col) { // In eliminated col - if(cdata_[j_].nelim < ncol()) { // If there are failed pivots - ipc_ rfrom = (i_ <= elim_col) ? cdata_[i_].nelim : 0; - backup.restore_part(i_, j_, rfrom, cdata_[j_].nelim, aval_, lda_); - } - // Release resources regardless, no longer required - backup.release(i_, j_); - } - } - - /** \brief Factorize diagonal block. - * \details Performs the in-place factorization - * \f[ A_{ii} = P L_{ii} D_i L_{ii}^T P^T. \f] - * The mechanism to do so varies: - * - If block_size != BLOCK_SIZE then recurse with a call to - * LDLT::factor() using BLOCK_SIZE as the new block size. - * - Otherwise, if the block is a full block of size BLOCK_SIZE, - * call block_ldlt(). - * - Otherwise, if the block is not full, call ldlt_tpp_factor(). - * Note that two permutations are maintained, the user permutation - * perm, and the local permutation lperm obtained from - * ColumnData::get_lperm() that represents P above. - * \tparam Allocator allocator type to be used on recursion to - * LDLT::factor(). - * \param next_elim Next variable to be eliminated, used to determine - * location in d to be used. - * \param perm User permutation: entries are permuted in same way as - * matrix columns. - * \param d pointer to global array for D. - * \param control user-supplied control - * \param work vector of thread-specific workspaces - * \param alloc allocator instance to be used on recursion to - * LDLT::factor(). - */ - template - ipc_ factor(ipc_ next_elim, ipc_* perm, T* d, - struct cpu_factor_control const &control, - std::vector& work, Allocator const& alloc) { - if(i_ != j_) - throw std::runtime_error("factor called on non-diagonal block!"); - ipc_* lperm = cdata_.get_lperm(i_); - for(ipc_ i=0; i inner_backup( - nrow(), ncol(), INNER_BLOCK_SIZE, alloc - ); - bool const use_tasks = false; // Don't run in parallel at lower level - bool const debug = false; // Don't print debug info for inner call - cdata_[i_].nelim = - LDLT, - use_tasks, debug, Allocator> - ::factor( - nrow(), ncol(), lperm, aval_, lda_, - cdata_[i_].d, inner_backup, control, control.pivot_method, - INNER_BLOCK_SIZE, 0, nullptr, 0, work, alloc - ); - if(cdata_[i_].nelim < 0) return cdata_[i_].nelim; - ipc_* temp = work[omp_get_thread_num()].get_ptr(ncol()); - ipc_* blkperm = &perm[i_*block_size_]; - for(ipc_ i=0; i(2*INNER_BLOCK_SIZE); - cdata_[i_].nelim = ldlt_tpp_factor( - nrow(), ncol(), lperm, aval_, lda_, - cdata_[i_].d, ld, INNER_BLOCK_SIZE, control.action, - control.u, control.small - ); - if(cdata_[i_].nelim < 0) return cdata_[i_].nelim; - ipc_* temp = work[omp_get_thread_num()].get_ptr(ncol()); - ipc_* blkperm = &perm[i_*INNER_BLOCK_SIZE]; - for(ipc_ i=0; i( - INNER_BLOCK_SIZE*INNER_BLOCK_SIZE - ); - block_ldlt( - 0, blkperm, aval_, lda_, cdata_[i_].d, ld, control.action, - control.u, control.small, lperm - ); - cdata_[i_].nelim = INNER_BLOCK_SIZE; - } - } - return cdata_[i_].nelim; - } - - /** \brief Apply pivots to this block and return number of pivots passing - * a posteori pivot test. - * \details If this block is below dblk, perform the operation - * \f[ L_{ij} = A_{ij} (D_j L_{jj})^{-T} \f] - * otherwise, if this block is to left of dblk, perform the - * operation - * \f[ L_{ij} = (D_i L_{ii})^{-1} A_{ij} \f] - * but only to uneliminated columns. - * After operation has completed, check a posteori pivoting - * condition \f$ l_{ij} < u^{-1} \f$ and return first column - * (block below dblk) or row (block left of dblk) in which - * it fails, or the total number of rows/columns otherwise. - * \param dblk The diagonal block to apply. - * \param u The pivot threshold for threshold test. - * \param small The drop tolerance for zero testing. - * \returns Number of successful pivots in this block. - */ - ipc_ apply_pivot_app(Block const& dblk, T u, T small) { - if(i_ == j_) - throw std::runtime_error("apply_pivot called on diagonal block!"); - if(i_ == dblk.i_) { // Apply within row (ApplyT) - apply_pivot( - cdata_[i_].nelim, ncol(), cdata_[j_].nelim, dblk.aval_, - cdata_[i_].d, small, aval_, lda_ - ); - return check_threshold( - 0, cdata_[i_].nelim, cdata_[j_].nelim, ncol(), u, aval_, lda_ - ); - } else if(j_ == dblk.j_) { // Apply within column (ApplyN) - apply_pivot( - nrow(), cdata_[j_].nelim, 0, dblk.aval_, - cdata_[j_].d, small, aval_, lda_ - ); - return check_threshold( - 0, nrow(), 0, cdata_[j_].nelim, u, aval_, lda_ - ); - } else { - throw std::runtime_error("apply_pivot called on block outside eliminated column"); - } - } - - /** \brief Perform update of this block. - * \details Perform an update using the outer product of the supplied - * blocks: - * \f[ A_{ij} = A_{ij} - L_{ik} D_k L_{jk}^T \f] - * If this block is in the last "real" block column, optionally - * apply the same update to the supplied part of the contribution - * block that maps on to the "missing" part of this block. - * \param isrc The Block L_{ik}. - * \param jsrc The Block L_{jk}. - * \param work Thread-specific workspace. - * \param beta Global coefficient of original \f$ U_{ij} \f$ value. - * See form_contrib() for details. - * \param upd Optional pointer to \f$ U_{ij} \f$ values to be updated. - * If this is null, no such update is performed. - * \param ldupd Leading dimension of upd. - */ - void update(Block const& isrc, Block const& jsrc, Workspace& work, - rpc_ beta=1.0, T* upd=nullptr, ipc_ ldupd=0) { - if(isrc.i_ == i_ && isrc.j_ == jsrc.j_) { - // Update to right of elim column (UpdateN) - ipc_ elim_col = isrc.j_; - if(cdata_[elim_col].nelim == 0) return; // nothing to do - ipc_ rfrom = (i_ <= elim_col) ? cdata_[i_].nelim : 0; - ipc_ cfrom = (j_ <= elim_col) ? cdata_[j_].nelim : 0; - ipc_ ldld = align_lda(block_size_); - rpc_ one_val = 1.0; - rpc_ minus_one_val = - 1.0; - T* ld = work.get_ptr(block_size_*ldld); - // NB: we use ld[rfrom] below so alignment matches that of aval[rfrom] - calcLD( - nrow()-rfrom, cdata_[elim_col].nelim, &isrc.aval_[rfrom], - lda_, cdata_[elim_col].d, &ld[rfrom], ldld - ); - host_gemm( - OP_N, OP_T, nrow()-rfrom, ncol()-cfrom, cdata_[elim_col].nelim, - minus_one_val, &ld[rfrom], ldld, &jsrc.aval_[cfrom], lda_, - one_val, &aval_[cfrom*lda_+rfrom], lda_ - ); - if(upd && j_==calc_nblk(n_,block_size_)-1) { - // Handle fractional part of upd that "belongs" to this block - ipc_ u_ncol = std::min(block_size_-ncol(), m_-n_); // ncol for upd - beta = (cdata_[elim_col].first_elim) ? beta : 1.0; // user beta only on first update - if(i_ == j_) { - // diagonal block - host_gemm( - OP_N, OP_T, u_ncol, u_ncol, cdata_[elim_col].nelim, - minus_one_val, &ld[ncol()], ldld, - &jsrc.aval_[ncol()], lda_, - beta, upd, ldupd - ); - } else { - // off-diagonal block - T* upd_ij = - &upd[(i_-calc_nblk(n_,block_size_))*block_size_+u_ncol]; - host_gemm( - OP_N, OP_T, nrow(), u_ncol, cdata_[elim_col].nelim, - minus_one_val, &ld[rfrom], ldld, &jsrc.aval_[ncol()], lda_, - beta, upd_ij, ldupd - ); - } - } - } else { - // Update to left of elim column (UpdateT) - ipc_ elim_col = jsrc.i_; - if(cdata_[elim_col].nelim == 0) return; // nothing to do - ipc_ rfrom = (i_ <= elim_col) ? cdata_[i_].nelim : 0; - ipc_ cfrom = (j_ <= elim_col) ? cdata_[j_].nelim : 0; - ipc_ ldld = align_lda(block_size_); - T* ld = work.get_ptr(block_size_*ldld); - // NB: we use ld[rfrom] below so alignment matches that of aval[rfrom] - if(isrc.j_==elim_col) { - calcLD( - nrow()-rfrom, cdata_[elim_col].nelim, - &isrc.aval_[rfrom], lda_, - cdata_[elim_col].d, &ld[rfrom], ldld - ); - } else { - calcLD( - nrow()-rfrom, cdata_[elim_col].nelim, & - isrc.aval_[rfrom*lda_], lda_, - cdata_[elim_col].d, &ld[rfrom], ldld - ); - } - rpc_ one_val = 1.0; - rpc_ minus_one_val = - 1.0; - host_gemm( - OP_N, OP_N, nrow()-rfrom, ncol()-cfrom, cdata_[elim_col].nelim, - minus_one_val, &ld[rfrom], ldld, &jsrc.aval_[cfrom*lda_], lda_, - one_val, &aval_[cfrom*lda_+rfrom], lda_ - ); - } - } - - /** \brief Update this block as part of contribution block. - * \details Treat this block's coordinates as beloning to the trailing - * matrix (contribution block/generated elment) and perform an - * update using the outer product of the supplied blocks. - * \f[ U_{ij} = U_{ij} - L_{ik} D_k L_{jk}^T \f] - * If this is the first update to \f$ U_{ij} \f$, the existing - * values are multipled by a user-supplied coefficient - * \f$ \beta \f$. - * \param isrc the Block L_{ik}. - * \param jsrc the Block L_{jk}. - * \param work this thread's workspace. - * \param beta Global coefficient of original \f$ U_{ij} \f$ value. - * \param upd_ij pointer to \f$ U_{ij} \f$ values to be updated. - * \param ldupd leading dimension of upd_ij. - */ - void form_contrib(Block const& isrc, Block const& jsrc, Workspace& work, rpc_ beta, T* upd_ij, ipc_ ldupd) { - ipc_ elim_col = isrc.j_; - ipc_ ldld = align_lda(block_size_); - T* ld = work.get_ptr(block_size_*ldld); - calcLD( - nrow(), cdata_[elim_col].nelim, isrc.aval_, lda_, - cdata_[elim_col].d, ld, ldld - ); - // User-supplied beta only on first update; otherwise 1.0 - T rbeta = (cdata_[elim_col].first_elim) ? beta : 1.0; - ipc_ blkn = get_nrow(j_); // nrow not ncol as we're on contrib - rpc_ minus_one_val = - 1.0; - host_gemm( - OP_N, OP_T, nrow(), blkn, cdata_[elim_col].nelim, - minus_one_val, ld, ldld, jsrc.aval_, lda_, - rbeta, upd_ij, ldupd - ); - } - - /** \brief Returns true if block contains NaNs or Infs (debug only). - * \param elim_col if supplied, the block column currently being considered - * for elimination. Entries in that block row/column marked as - * failed are ignored. - */ - bool isnan(ipc_ elim_col=-1) const { - ipc_ m = (i_==elim_col) ? cdata_[i_].get_npass() : nrow(); - ipc_ n = (j_==elim_col) ? cdata_[j_].get_npass() : ncol(); - for(ipc_ j=0; j(aval_[j*lda_+i]))) { -#else - if(!std::isfinite(aval_[j*lda_+i])) { -#endif - printf("%d, %d is inf\n", i, j); - return true; - } - } - return false; - } - - /** \brief Prints block (debug only) */ - void print() const { - printf("Block %d, %d (%d x %d):\n", i_, j_, nrow(), ncol()); - for(ipc_ i=0; i& cdata_; ///< global column data array - T* aval_; ///< pointer to underlying matrix storage -}; - -/** \brief Grouping of assorted functions for LDL^T factorization that share - * template paramters. - * \tparam T underlying datatype, e.g. double - * \tparam BLOCK_SIZE inner block size for factorization, must be a multiple - * of vector length. - * \tparam Backup class to be used for handling block backups, - * e.g. PoolBackup or CopyBackup. - * \tparam use_tasks enable use of OpenMP tasks if true (used to serialise - * internal call for small block sizes). - * \tparam debug enable debug output. - * \tparam Allocator allocator to use for internal memory allocations - */ -template -class LDLT { - /// \{ - typedef typename std::allocator_traits::template rebind_alloc IntAlloc; - typedef typename std::allocator_traits::template rebind_alloc TAlloc; - /// \} -private: - /** Performs LDL^T factorization with block pivoting. Detects failure - * and aborts only column if an a posteori pivot test fails. */ - static - ipc_ run_elim_pivoted(ipc_ const m, ipc_ const n, ipc_* perm, T* a, - ipc_ const lda, T* d, ColumnData& cdata, Backup& backup, - struct cpu_factor_control const& control, ipc_ const block_size, - T const beta, T* upd, ipc_ const ldupd, std::vector& work, - Allocator const& alloc, ipc_ const from_blk=0) { - typedef Block BlockSpec; - - ipc_ const nblk = calc_nblk(n, block_size); - ipc_ const mblk = calc_nblk(m, block_size); - //printf("ENTRY PIV %d %d vis %d %d %d\n", m, n, mblk, nblk, block_size); - - /* Setup */ - ipc_ next_elim = from_blk*block_size; - ipc_ flag; - #pragma omp atomic write - flag = 0; - - /* Inner loop - iterate over block columns */ - bool abort; - #pragma omp atomic write - abort = false; - - #pragma omp taskgroup - for (ipc_ blk = from_blk; blk < nblk; blk++) { - /*if(debug) { - printf("Bcol %d:\n", blk); - print_mat(mblk, nblk, m, n, blkdata, cdata, lda); - }*/ - - // Factor diagonal: depend on perm[blk*block_size] as we init npass - #pragma omp task \ - firstprivate(blk) \ - shared(a, abort, perm, backup, cdata, next_elim, d, \ - control, work, alloc, flag) \ - depend(inout: a[blk*block_size*lda+blk*block_size:1]) \ - depend(inout: perm[blk*block_size:1]) - { - bool my_abort; - #pragma omp atomic read - my_abort = abort; - if (!my_abort) { - try { - // #pragma omp cancellation point taskgroup - if (debug) printf("Factor(%" d_ipc_ ")\n", blk); - BlockSpec dblk(blk, blk, m, n, cdata, a, lda, block_size); - // Store a copy for recovery in case of a failed column - dblk.backup(backup); - // Perform actual factorization - ipc_ nelim = dblk.template factor(next_elim, perm, d, - control, work, alloc); - if (nelim < 0) { - #pragma omp atomic write - flag = nelim; -#ifdef _OPENMP - #pragma omp atomic write - abort = true; - #pragma omp cancel taskgroup -#else - return flag; -#endif /* _OPENMP */ - } else { - // Init threshold check (non locking => task dependencies) - cdata[blk].init_passed(nelim); - } - } catch(std::bad_alloc const&) { - #pragma omp atomic write - flag = Flag::ERROR_ALLOCATION; -#ifdef _OPENMP - #pragma omp atomic write - abort = true; - #pragma omp cancel taskgroup -#else - return flag; -#endif /* _OPENMP */ - } catch(SingularError const&) { - #pragma omp atomic write - flag = Flag::ERROR_SINGULAR; -#ifdef _OPENMP - #pragma omp atomic write - abort = true; - #pragma omp cancel taskgroup -#else - return flag; -#endif /* _OPENMP */ - } - } } /* task/abort */ - - // Loop over off-diagonal blocks applying pivot - for(ipc_ jblk = 0; jblk < blk; jblk++) { - #pragma omp task \ - firstprivate(blk, jblk) \ - shared(a, abort, backup, cdata, control) \ - depend(in: a[blk*block_size*lda+blk*block_size:1]) \ - depend(inout: a[jblk*block_size*lda+blk*block_size:1]) \ - depend(in: perm[blk*block_size:1]) - { - bool my_abort; - #pragma omp atomic read - my_abort = abort; - if (!my_abort) { - // #pragma omp cancellation point taskgroup - if (debug) printf("ApplyT(%" d_ipc_ ",%" d_ipc_ ")\n", - blk, jblk); - BlockSpec dblk(blk, blk, m, n, cdata, a, lda, block_size); - BlockSpec cblk(blk, jblk, m, n, cdata, a, lda, block_size); - // Apply row permutation from factorization of dblk and in - // the process, store a (permuted) copy for recovery in case of - // a failed column - cblk.apply_rperm_and_backup(backup); - // Perform elimination and determine number of rows in block - // passing a posteori threshold pivot test - ipc_ blkpass = cblk.apply_pivot_app(dblk, control.u, - control.small); - // Update column's passed pivot count - cdata[blk].update_passed(blkpass); - } } /* task/abort */ - } - for (ipc_ iblk = blk + 1; iblk < mblk; iblk++) { - #pragma omp task \ - firstprivate(blk, iblk) \ - shared(a, abort, backup, cdata, control) \ - depend(in: a[blk*block_size*lda+blk*block_size:1]) \ - depend(inout: a[blk*block_size*lda+iblk*block_size:1]) \ - depend(in: perm[blk*block_size:1]) - { - bool my_abort; - #pragma omp atomic read - my_abort = abort; - if (!my_abort) { - // #pragma omp cancellation point taskgroup - if (debug) printf("ApplyN(%" d_ipc_ ",%" d_ipc_ ")\n", - iblk, blk); - BlockSpec dblk(blk, blk, m, n, cdata, a, lda, block_size); - BlockSpec rblk(iblk, blk, m, n, cdata, a, lda, block_size); - // Apply column permutation from factorization of dblk and in - // the process, store a (permuted) copy for recovery in case of - // a failed column - rblk.apply_cperm_and_backup(backup); - // Perform elimination and determine number of rows in block - // passing a posteori threshold pivot test - ipc_ blkpass = rblk.apply_pivot_app(dblk, control.u, - control.small); - // Update column's passed pivot count - cdata[blk].update_passed(blkpass); - } } /* task/abort */ - } - - // Adjust column once all applys have finished and we know final - // number of passed columns. - #pragma omp task default(none) \ - firstprivate(blk) \ - shared(abort, cdata, next_elim) \ - depend(inout: perm[blk*block_size:1]) - { - bool my_abort; - #pragma omp atomic read - my_abort = abort; - if (!my_abort) { - // #pragma omp cancellation point taskgroup - if (debug) printf("Adjust(%" d_ipc_ ")\n", blk); - cdata[blk].adjust(next_elim); - } } /* task/abort */ - - // Update uneliminated columns - for (ipc_ jblk = 0; jblk < blk; jblk++) { - for (ipc_ iblk = jblk; iblk < mblk; iblk++) { - // Calculate block index we depend on for i - // (we only work with lower half of matrix) - ipc_ adep_idx = (blk < iblk) ? blk*block_size*lda + iblk*block_size - : iblk*block_size*lda + blk*block_size; - #pragma omp task \ - firstprivate(blk, iblk, jblk) \ - shared(a, abort, cdata, backup, work) \ - depend(inout: a[jblk*block_size*lda+iblk*block_size:1]) \ - depend(in: perm[blk*block_size:1]) \ - depend(in: a[jblk*block_size*lda+blk*block_size:1]) \ - depend(in: a[adep_idx:1]) - { - bool my_abort; - #pragma omp atomic read - my_abort = abort; - if (!my_abort) { - // #pragma omp cancellation point taskgroup - if (debug) printf("UpdateT(%" d_ipc_ ",%" d_ipc_ ",%" d_ipc_ - ")\n", iblk, jblk, blk); - int thread_num = omp_get_thread_num(); - BlockSpec ublk(iblk, jblk, m, n, cdata, a, lda, block_size); - ipc_ isrc_row = (blk<=iblk) ? iblk : blk; - ipc_ isrc_col = (blk<=iblk) ? blk : iblk; - BlockSpec isrc(isrc_row, isrc_col, m, n, cdata, a, lda, - block_size); - BlockSpec jsrc(blk, jblk, m, n, cdata, a, lda, block_size); - // If we're on the block row we've just eliminated, restore - // any failed rows and release resources storing backup - ublk.restore_if_required(backup, blk); - // Perform actual update - ublk.update(isrc, jsrc, work[thread_num]); - } } /* task/abort */ - } - } - for(ipc_ jblk = blk; jblk < nblk; jblk++) { - for(ipc_ iblk = jblk; iblk < mblk; iblk++) { - #pragma omp task \ - firstprivate(blk, iblk, jblk) \ - shared(a, abort, cdata, backup, work, upd) \ - depend(inout: a[jblk*block_size*lda+iblk*block_size:1]) \ - depend(in: perm[blk*block_size:1]) \ - depend(in: a[blk*block_size*lda+iblk*block_size:1]) \ - depend(in: a[blk*block_size*lda+jblk*block_size:1]) - { - bool my_abort; - #pragma omp atomic read - my_abort = abort; - if (!my_abort) { - // #pragma omp cancellation point taskgroup - if (debug) printf("UpdateN(%" d_ipc_ ",%" d_ipc_ ",%" d_ipc_ - ")\n", iblk, jblk, blk); - int thread_num = omp_get_thread_num(); - BlockSpec ublk(iblk, jblk, m, n, cdata, a, lda, block_size); - BlockSpec isrc(iblk, blk, m, n, cdata, a, lda, block_size); - BlockSpec jsrc(jblk, blk, m, n, cdata, a, lda, block_size); - // If we're on the block col we've just eliminated, restore - // any failed cols and release resources storing backup - ublk.restore_if_required(backup, blk); - // Perform actual update - ublk.update(isrc, jsrc, work[thread_num], beta, upd, ldupd); - } } /* task/abort */ - } - } - - // Handle update to contribution block, if required - if (upd && (mblk > nblk)) { - ipc_ uoffset = std::min(nblk*block_size, m) - n; - T *upd2 = &upd[uoffset*(ldupd+1)]; - for(ipc_ jblk = nblk; jblk < mblk; ++jblk) - for(ipc_ iblk = jblk; iblk < mblk; ++iblk) { - T* upd_ij = &upd2[(jblk-nblk)*block_size*ldupd + (iblk-nblk)*block_size]; - #pragma omp task \ - firstprivate(iblk, jblk, blk, upd_ij) \ - shared(a, abort, upd2, cdata, work) \ - depend(inout: upd_ij[0:1]) \ - depend(in: perm[blk*block_size:1]) \ - depend(in: a[blk*block_size*lda+iblk*block_size:1]) \ - depend(in: a[blk*block_size*lda+jblk*block_size:1]) - { - bool my_abort; - #pragma omp atomic read - my_abort = abort; - if (!my_abort) { - // #pragma omp cancellation point taskgroup - if (debug) printf("FormContrib(%" d_ipc_ ",%" d_ipc_ - ",%" d_ipc_ ")\n", iblk,jblk,blk); - int thread_num = omp_get_thread_num(); - BlockSpec ublk(iblk, jblk, m, n, cdata, a, lda, block_size); - BlockSpec isrc(iblk, blk, m, n, cdata, a, lda, block_size); - BlockSpec jsrc(jblk, blk, m, n, cdata, a, lda, block_size); - ublk.form_contrib(isrc, jsrc, work[thread_num], - beta, upd_ij, ldupd); - } } /* task/abort */ - } - } - } // taskgroup and for - ipc_ my_flag; - #pragma omp atomic read - my_flag = flag; - if (my_flag < 0) return my_flag; // Error - - /*if(debug) { - printf("PostElim:\n"); - print_mat(mblk, nblk, m, n, blkdata, cdata, lda); - }*/ - - return next_elim; - } - - /** Performs LDL^T factorization with block pivoting. Detects failure - * and aborts only column if an a posteori pivot test fails. - * Serial version without tasks. */ - static - ipc_ run_elim_pivoted_notasks(ipc_ const m, ipc_ const n, ipc_* perm, T* a, - ipc_ const lda, T* d, ColumnData& cdata, Backup& backup, - struct cpu_factor_control const& control, ipc_ const block_size, - T const beta, T* upd, ipc_ const ldupd, std::vector& work, - Allocator const& alloc, ipc_ const from_blk=0) { - typedef Block BlockSpec; - - ipc_ const nblk = calc_nblk(n, block_size); - ipc_ const mblk = calc_nblk(m, block_size); - //printf("ENTRY PIV %d %d vis %d %d %d\n", m, n, mblk, nblk, block_size); - - /* Setup */ - ipc_ next_elim = from_blk*block_size; - - /* Inner loop - iterate over block columns */ - try { - for(ipc_ blk=from_blk; blk( - next_elim, perm, d, control, work, alloc - ); - if(nelim<0) return nelim; - // Init threshold check (non locking => task dependencies) - cdata[blk].init_passed(nelim); - } - - // Loop over off-diagonal blocks applying pivot - for(ipc_ jblk=0; jblknblk) { - ipc_ uoffset = std::min(nblk*block_size, m) - n; - T *upd2 = &upd[uoffset*(ldupd+1)]; - for(ipc_ jblk=nblk; jblk& cdata, Backup& backup, - ipc_* up_to_date, struct cpu_factor_control const& control, - ipc_ const block_size, T const beta, T* upd, ipc_ const ldupd, - std::vector& work, Allocator const& alloc) { - typedef Block BlockSpec; - - ipc_ const nblk = calc_nblk(n, block_size); - ipc_ const mblk = calc_nblk(m, block_size); - //printf("ENTRY %d %d vis %d %d %d\n", m, n, mblk, nblk, block_size); - - /* Setup */ - ipc_ next_elim = 0; - ipc_ flag; - #pragma omp atomic write - flag = 0; - - /* Inner loop - iterate over block columns */ - bool abort; - #pragma omp atomic write - abort = false; - #pragma omp taskgroup - for(ipc_ blk = 0; blk < nblk; blk++) { - /*if(debug) { - printf("Bcol %d:\n", blk); - print_mat(mblk, nblk, m, n, blkdata, cdata, lda); - }*/ - - // Factor diagonal - #pragma omp task \ - firstprivate(blk) \ - shared(a, abort, perm, backup, cdata, next_elim, d, \ - control, work, alloc, up_to_date, flag) \ - depend(inout: a[blk*block_size*lda+blk*block_size:1]) - { - bool my_abort; - #pragma omp atomic read - my_abort = abort; - if (!my_abort) { - try { - // #pragma omp cancellation point taskgroup - if(debug) printf("Factor(%" d_ipc_ ")\n", blk); - BlockSpec dblk(blk, blk, m, n, cdata, a, lda, block_size); - // On first access to this block, store copy in case of failure - if (blk == 0) dblk.backup(backup); - // Record block state as assuming we've done up to col blk - up_to_date[blk*mblk+blk] = blk; - // Perform actual factorization - ipc_ nelim = dblk.template factor(next_elim, perm, d, control, work, alloc); - if (nelim < get_ncol(blk, n, block_size)) { - cdata[blk].init_passed(0); // diagonal block has NOT passed -#ifdef _OPENMP - #pragma omp atomic write - abort = true; - #pragma omp cancel taskgroup -#else - return cdata.calc_nelim(m); -#endif /* _OPENMP */ - } else { - cdata[blk].first_elim = (blk==0); - cdata[blk].init_passed(1); // diagonal block has passed - next_elim += nelim; // we're assuming everything works - } - } catch(std::bad_alloc const&) { - #pragma omp atomic write - flag = Flag::ERROR_ALLOCATION; -#ifdef _OPENMP - #pragma omp atomic write - abort = true; - #pragma omp cancel taskgroup -#else - return flag; -#endif /* _OPENMP */ - } catch(SingularError const&) { - #pragma omp atomic write - flag = Flag::ERROR_SINGULAR; -#ifdef _OPENMP - #pragma omp atomic write - abort = true; - #pragma omp cancel taskgroup -#else - return flag; -#endif /* _OPENMP */ - } - } } /* task/abort */ - - // Loop over off-diagonal blocks applying pivot - for (ipc_ jblk = 0; jblk < blk; jblk++) { - #pragma omp task \ - firstprivate(blk, jblk) \ - shared(a, abort, backup, cdata, control, work, up_to_date) \ - depend(in: a[blk*block_size*lda+blk*block_size:1]) \ - depend(inout: a[jblk*block_size*lda+blk*block_size:1]) - { - bool my_abort; - #pragma omp atomic read - my_abort = abort; - if (!my_abort) { - // #pragma omp cancellation point taskgroup - if (debug) printf("ApplyT(%" d_ipc_ ",%" d_ipc_ ")\n", - blk, jblk); - int thread_num = omp_get_thread_num(); - BlockSpec dblk(blk, blk, m, n, cdata, a, lda, block_size); - BlockSpec cblk(blk, jblk, m, n, cdata, a, lda, block_size); - // Record block state as assuming we've done up to col blk - up_to_date[jblk*mblk+blk] = blk; - // Apply row permutation from factorization of dblk - cblk.apply_rperm(work[thread_num]); - // NB: no actual application of pivot must be done, as we are - // assuming everything has passed... - } } /* task/abort */ - } - for (ipc_ iblk = blk+1; iblk < mblk; iblk++) { - #pragma omp task \ - firstprivate(blk, iblk) \ - shared(a, abort, backup, cdata, control, work, up_to_date) \ - depend(in: a[blk*block_size*lda+blk*block_size:1]) \ - depend(inout: a[blk*block_size*lda+iblk*block_size:1]) - { - bool my_abort; - #pragma omp atomic read - my_abort = abort; - if (!my_abort) { - // #pragma omp cancellation point taskgroup - if (debug) printf("ApplyN(%" d_ipc_ ",%" d_ipc_ ")\n", - iblk, blk); - int thread_num = omp_get_thread_num(); - BlockSpec dblk(blk, blk, m, n, cdata, a, lda, block_size); - BlockSpec rblk(iblk, blk, m, n, cdata, a, lda, block_size); - // On first access to this block, store copy in case of failure - if (blk==0) rblk.backup(backup); - // Record block state as assuming we've done up to col blk - up_to_date[blk*mblk+iblk] = blk; - // Apply column permutation from factorization of dblk - rblk.apply_cperm(work[thread_num]); - // Perform elimination and determine number of rows in block - // passing a posteori threshold pivot test - ipc_ blkpass = rblk.apply_pivot_app(dblk, control.u, control.small); - // Update column's passed pivot count - if (cdata[blk].test_fail(blkpass)) { -#ifdef _OPENMP - #pragma omp atomic write - abort = true; - #pragma omp cancel taskgroup -#else - return cdata.calc_nelim(m); -#endif /* _OPENMP */ - } - } } /* task/abort */ - } - - // Update uneliminated columns - // Column blk only needed if upd is present - ipc_ jsa = (upd) ? blk : blk + 1; - for(ipc_ jblk = jsa; jblk < nblk; jblk++) { - for(ipc_ iblk = jblk; iblk < mblk; iblk++) { - #pragma omp task \ - firstprivate(blk, iblk, jblk) \ - shared(a, abort, cdata, backup, work, upd, up_to_date) \ - depend(inout: a[jblk*block_size*lda+iblk*block_size:1]) \ - depend(in: a[blk*block_size*lda+iblk*block_size:1]) \ - depend(in: a[blk*block_size*lda+jblk*block_size:1]) - { - bool my_abort; - #pragma omp atomic read - my_abort = abort; - if (!my_abort) { - // #pragma omp cancellation point taskgroup - if (debug) printf("UpdateN(%" d_ipc_ ",%" d_ipc_ ",%" d_ipc_ - ")\n", iblk, jblk, blk); - int thread_num = omp_get_thread_num(); - BlockSpec ublk(iblk, jblk, m, n, cdata, a, lda, block_size); - BlockSpec isrc(iblk, blk, m, n, cdata, a, lda, block_size); - BlockSpec jsrc(jblk, blk, m, n, cdata, a, lda, block_size); - // On first access to this block, store copy in case of fail - if ((blk == 0) && (jblk != blk)) ublk.backup(backup); - // Record block state as assuming we've done up to col blk - up_to_date[jblk*mblk+iblk] = blk; - // Actual update - ublk.update(isrc, jsrc, work[thread_num], beta, upd, ldupd); - } } /* task/abort */ - } - } - - // Handle update to contribution block, if required - if (upd && (mblk > nblk)) { - ipc_ uoffset = std::min(nblk*block_size, m) - n; - T *upd2 = &upd[uoffset*(ldupd+1)]; - for(ipc_ jblk = nblk; jblk < mblk; ++jblk) - for(ipc_ iblk = jblk; iblk < mblk; ++iblk) { - T* upd_ij = &upd2[(jblk-nblk)*block_size*ldupd + (iblk-nblk)*block_size]; - #pragma omp task \ - firstprivate(iblk, jblk, blk, upd_ij) \ - shared(a, abort, upd2, cdata, work, up_to_date) \ - depend(inout: upd_ij[0:1]) \ - depend(in: a[blk*block_size*lda+iblk*block_size:1]) \ - depend(in: a[blk*block_size*lda+jblk*block_size:1]) - { - bool my_abort; - #pragma omp atomic read - my_abort = abort; - if (!my_abort) { - // #pragma omp cancellation point taskgroup - if (debug) printf("FormContrib(%" d_ipc_ ",%" d_ipc_ - ",%" d_ipc_ ")\n", iblk, jblk,blk); - int thread_num = omp_get_thread_num(); - BlockSpec ublk(iblk, jblk, m, n, cdata, a, lda, block_size); - BlockSpec isrc(iblk, blk, m, n, cdata, a, lda, block_size); - BlockSpec jsrc(jblk, blk, m, n, cdata, a, lda, block_size); - // Record block state as assuming we've done up to col blk - up_to_date[jblk*mblk+iblk] = blk; - // Perform update - ublk.form_contrib(isrc, jsrc, work[thread_num], beta, - upd_ij, ldupd); - } } /* task/abort */ - } - } - } // taskgroup and for - - /*if(debug) { - printf("PostElim:\n"); - print_mat(mblk, nblk, m, n, blkdata, cdata, lda); - }*/ - - ipc_ my_flag; - #pragma omp atomic read - my_flag = flag; - if (my_flag < 0) return my_flag; - return cdata.calc_nelim(m); - } - - /** Performs LDL^T factorization assuming everything works. Detects failure - * and aborts entire thing if a posteori pivot test fails. */ - static - ipc_ run_elim_unpivoted_notasks(ipc_ const m, ipc_ const n, ipc_* perm, T* a, - ipc_ const lda, T* d, ColumnData& cdata, Backup& backup, - ipc_* up_to_date, struct cpu_factor_control const& control, - ipc_ const block_size, T const beta, T* upd, ipc_ const ldupd, - std::vector& work, Allocator const& alloc) { - typedef Block BlockSpec; - - ipc_ const nblk = calc_nblk(n, block_size); - ipc_ const mblk = calc_nblk(m, block_size); - //printf("ENTRY %d %d vis %d %d %d\n", m, n, mblk, nblk, block_size); - - /* Setup */ - ipc_ next_elim = 0; - - /* Inner loop - iterate over block columns */ - for(ipc_ blk=0; blk( - next_elim, perm, d, control, work, alloc - ); - if(nelim < get_ncol(blk, n, block_size)) { - cdata[blk].init_passed(0); // diagonal block has NOT passed - return cdata.calc_nelim(m); - } else { - cdata[blk].first_elim = (blk==0); - cdata[blk].init_passed(1); // diagonal block has passed - next_elim += nelim; // we're assuming everything works - } - } catch(std::bad_alloc const&) { - return Flag::ERROR_ALLOCATION; - } catch(SingularError const&) { - return Flag::ERROR_SINGULAR; - } - - // Loop over off-diagonal blocks applying pivot - for(ipc_ jblk=0; jblknblk) { - ipc_ uoffset = std::min(nblk*block_size, m) - n; - T *upd2 = &upd[uoffset*(ldupd+1)]; - for(ipc_ jblk=nblk; jblk nelim_blk then we reset and recalculate completely - * */ - static - void restore(ipc_ const nelim_blk, ipc_ const m, ipc_ const n, ipc_* perm, T* a, - ipc_ const lda, T* d, ColumnData& cdata, Backup& backup, - ipc_ const* old_perm, ipc_ const* up_to_date, ipc_ const block_size, - std::vector& work, T* upd, ipc_ const ldupd) { - typedef Block BlockSpec; - - ipc_ const nblk = calc_nblk(n, block_size); - ipc_ const mblk = calc_nblk(m, block_size); - - /* Restore perm for failed part */ - for(ipc_ i=nelim_blk*block_size; i= nelim_blk) { - #pragma omp task \ - firstprivate(iblk, jblk) \ - shared(a, cdata, work) \ - depend(inout: a[jblk*block_size*lda+iblk*block_size:1]) - { - int thread_num = omp_get_thread_num(); - BlockSpec rblk(iblk, jblk, m, n, cdata, a, lda, block_size); - rblk.apply_inv_rperm(work[thread_num]); - } - } - } - } - // Now all eliminated columns are good, fix up remainder of node - for(ipc_ jblk=nelim_blk; jblk= nelim_blk) { - // Bad updates applied, needs reset and full recalculation - #pragma omp task \ - firstprivate(iblk, jblk) \ - shared(a, backup, cdata) \ - depend(inout: a[jblk*block_size*lda+iblk*block_size:1]) - { - BlockSpec rblk(iblk, jblk, m, n, cdata, a, lda, block_size); - rblk.full_restore(backup); - } - progress = -1; - } - // Apply any missing updates to a - for(ipc_ kblk=progress+1; kblk= nelim_blk) progress = -1; // needs complete reset - T* upd_ij = &upd2[(jblk-nblk)*block_size*ldupd + - (iblk-nblk)*block_size]; - for(ipc_ kblk=progress+1; kblk 1) { - // We only need a taskwait here if we've launched any subtasks... - // NB: we don't use taskgroup as it doesn't support if() - #pragma omp taskwait - }*/ - - } - - /** \brief Print given matrix (for debug usage) - * \param m number of rows - * \param n number of columns - * \param perm[n] permutation of fully summed variables - * \param eliminated[n] status of fully summed variables - * \param a matrix values - * \param lda leading dimension of a - */ - static - void print_mat(ipc_ m, ipc_ n, const ipc_ *perm, - std::vector const& eliminated, const T *a, ipc_ lda) { - for(ipc_ row=0; row& work, Allocator const& alloc=Allocator()) { - /* Sanity check arguments */ - if(m < n) return -1; - if(lda < n) return -4; - - /* Initialize useful quantities: */ - ipc_ nblk = calc_nblk(n, block_size); - ipc_ mblk = calc_nblk(m, block_size); - - /* Temporary workspaces */ - ColumnData cdata(n, block_size, IntAlloc(alloc)); - - /* Main loop - * - Each pass leaves any failed pivots in place and keeps everything - * up-to-date. - * - If no pivots selected across matrix, perform swaps to get large - * entries into diagonal blocks - */ - ipc_ num_elim; - if(pivot_method == PivotMethod::app_aggressive) { - if(beta!=0.0) { - // We don't support backup of contribution block at present, - // so we only work if we assume it is zero to begin with - throw std::runtime_error( - "run_elim_unpivoted currently only supports beta=0.0" - ); - } - // Take a copy of perm. RAII vectors so they are freed on every path, - // including the error early-returns below (previously leaked). - std::vector perm_copy_vec(perm, perm+n, alloc); - ipc_* perm_copy = perm_copy_vec.data(); - size_t num_blocks = (upd) ? ((size_t) mblk)*mblk - : ((size_t) mblk)*nblk; - std::vector up_to_date_vec(num_blocks, -1, alloc); - ipc_* up_to_date = up_to_date_vec.data(); // -1: not even backed up yet - // Run the elimination - if(use_tasks && mblk>1) { - num_elim = run_elim_unpivoted( - m, n, perm, a, lda, d, cdata, backup, up_to_date, control, - block_size, beta, upd, ldupd, work, alloc - ); - } else { - num_elim = run_elim_unpivoted_notasks( - m, n, perm, a, lda, d, cdata, backup, up_to_date, control, - block_size, beta, upd, ldupd, work, alloc - ); - } - if(num_elim < 0) return num_elim; // error - if(num_elim < n) { - // Factorization ecountered a pivoting failure. - ipc_ nelim_blk = num_elim/block_size; - // Rollback to known good state - restore( - nelim_blk, m, n, perm, a, lda, d, cdata, backup, perm_copy, - up_to_date, block_size, work, upd, ldupd - ); - // Factorize more carefully - if(use_tasks && mblk>1) { - num_elim = run_elim_pivoted( - m, n, perm, a, lda, d, cdata, backup, control, block_size, - beta, upd, ldupd, work, alloc, nelim_blk - ); - } else { - num_elim = run_elim_pivoted_notasks( - m, n, perm, a, lda, d, cdata, backup, control, block_size, - beta, upd, ldupd, work, alloc, nelim_blk - ); - } - if(num_elim < 0) return num_elim; // error - } - } else { - if(use_tasks && mblk>1) { - num_elim = run_elim_pivoted( - m, n, perm, a, lda, d, cdata, backup, control, - block_size, beta, upd, ldupd, work, alloc - ); - } else { - num_elim = run_elim_pivoted_notasks( - m, n, perm, a, lda, d, cdata, backup, control, - block_size, beta, upd, ldupd, work, alloc - ); - } - if(num_elim < 0) return num_elim; // error - backup.release_all_memory(); // we're done with it now, but we want - // the memory back for reuse before we - // get it automatically when it goes out - // of scope. - } - - if(num_elim < n) { - // Permute failed entries to end - std::vector failed_perm(n-num_elim, 0, alloc); - for(ipc_ jblk=0, insert=0, fail_insert=0; jblk failed_diag(nfail*n, 0, alloc); - std::vector failed_rect(nfail*(m-n), 0, alloc); - for(ipc_ jblk=0, jfail=0, jinsert=0; jblk eliminated(n); - for(ipc_ i=0; i -size_t ldlt_app_factor_mem_required(ipc_ m, ipc_ n, ipc_ block_size) { -#if defined(__AVX512F__) - ipc_ const align = 64; -#elif defined(__AVX__) - ipc_ const align = 32; -#else - ipc_ const align = 16; -#endif - return align_lda(m) * n * sizeof(T) + align; // CopyBackup -} - -template -ipc_ ldlt_app_factor(ipc_ m, ipc_ n, ipc_* perm, T* a, ipc_ lda, T* d, T beta, - T* upd, ipc_ ldupd, struct cpu_factor_control const& control, - std::vector& work, Allocator const& alloc) { - // If we've got a tall and narrow node, adjust block size so each block - // has roughly blksz**2 entries - // FIXME: Decide if this reshape is actually useful, given it will generate - // a lot more update tasks instead? - ipc_ outer_block_size = control.cpu_block_size; - /*if(n < outer_block_size) { - outer_block_size = ipc_((longc_(outer_block_size)*outer_block_size) / n); - }*/ - - // Template parameters and workspaces - bool const debug = false; - //PoolBackup backup(m, n, outer_block_size, alloc); - CopyBackup backup(m, n, outer_block_size, alloc); - - // Actual call - bool const use_tasks = true; - return LDLT - , use_tasks, debug, - Allocator> - ::factor( - m, n, perm, a, lda, d, backup, control, control.pivot_method, - outer_block_size, beta, upd, ldupd, work, alloc - ); -} -template ipc_ ldlt_app_factor>>(ipc_, ipc_, ipc_*, rpc_*, ipc_, rpc_*, rpc_, - rpc_*, ipc_, struct cpu_factor_control const&, - std::vector&, - BuddyAllocator> const& alloc); - -template -void ldlt_app_solve_fwd(ipc_ m, ipc_ n, T const* l, ipc_ ldl, ipc_ nrhs, T* x, - ipc_ ldx) { - rpc_ one_val = 1.0; - rpc_ minus_one_val = - 1.0; - ipc_ one_integer = 1; - if(nrhs==one_integer) { - host_trsv(FILL_MODE_LWR, OP_N, DIAG_UNIT, n, l, ldl, x, one_integer); - if(m > n) - gemv(OP_N, m-n, n, minus_one_val, &l[n], ldl, x, one_integer, one_val, &x[n], one_integer); - } else { - host_trsm(SIDE_LEFT, FILL_MODE_LWR, OP_N, DIAG_UNIT, n, nrhs, - one_val, l, ldl, x, ldx); - if(m > n) - host_gemm(OP_N, OP_N, m-n, nrhs, n, minus_one_val, &l[n], - ldl, x, ldx, one_val, &x[n], ldx); - } -} -template void ldlt_app_solve_fwd(ipc_, ipc_, rpc_ const*, - ipc_, ipc_, rpc_*, ipc_); - -template -void ldlt_app_solve_diag(ipc_ n, T const* d, ipc_ nrhs, T* x, ipc_ ldx) { - for(ipc_ i=0; i(d[2*i+2]))) { -#else - if(i+1==n || std::isfinite(d[2*i+2])) { -#endif - // 1x1 pivot - T d11 = d[2*i]; - for(ipc_ r=0; r(ipc_, rpc_ const*, ipc_, - rpc_*, ipc_); - -template -void ldlt_app_solve_bwd(ipc_ m, ipc_ n, T const* l, ipc_ ldl, ipc_ nrhs, T* x, - ipc_ ldx) { - rpc_ one_val = 1.0; - rpc_ minus_one_val = - 1.0; - ipc_ one_integer = 1; - if(nrhs==one_integer) { - if(m > n) - gemv(OP_T, m-n, n, minus_one_val, &l[n], ldl, &x[n], one_integer, one_val, x, one_integer); - host_trsv(FILL_MODE_LWR, OP_T, DIAG_UNIT, n, l, ldl, x, one_integer); - } else { - if(m > n) - host_gemm(OP_T, OP_N, n, nrhs, m-n, minus_one_val, &l[n], ldl, - &x[n], ldx, one_val, x, ldx); - host_trsm(SIDE_LEFT, FILL_MODE_LWR, OP_T, DIAG_UNIT, n, nrhs, - one_val, l, ldl, x, ldx); - } -} -template void ldlt_app_solve_bwd(ipc_, ipc_, rpc_ const*, ipc_, - ipc_, rpc_*, ipc_); - -}}} /* namespaces galahad::ssids::cpu */ diff --git a/src/ssids/ldlt_nopiv.cxx b/src/ssids/ldlt_nopiv.cxx deleted file mode 100644 index b38157529d..0000000000 --- a/src/ssids/ldlt_nopiv.cxx +++ /dev/null @@ -1,117 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 09:00 GMT - */ - -#include "ssids_routines.h" -#include "ssids_cpu_kernels_ldlt_nopiv.hxx" - -namespace galahad { namespace ssids { namespace cpu { - -/* We perform a 2x2 blocked LDL^T factorization of an m x n matrix. - * This is not pivoted, and assumes we're doing this instead of a cholesky - * factorization. - * By doing a 2x2 blocked factor we only need n/2 divides, rather than the - * n divides + n sqrts of the Cholesky factorization, which is the throughput - * limiting operation for small matrices (at the cost of some additional - * multiplies). - * - * m - number of rows - * n - number of cols (n<=m) - * a[n*lda] - matrix to factor on input; factors on output - * lda - leading dimension of a (lda>=m) - * work[2*m] - workspace for internal use - * - * Returns -1 on success, otherwise location of negative or zero pivot. - * */ -ipc_ ldlt_nopiv_factor(ipc_ m, ipc_ n, rpc_* a, ipc_ lda, rpc_* work) { - for(ipc_ j=0; j=0; j-=2) { - for(ipc_ i=j+2; i -#include -#include -#include - -#include "galahad_modules.h" -#include "ssids_routines.h" -#include "ssids_cpu_kernels_ldlt_tpp.hxx" -#include "ssids_cpu_ThreadStats.hxx" -#include "ssids_cpu_kernels_wrappers.hxx" - -namespace galahad { namespace ssids { namespace cpu { - -namespace { - -/** overload fabs for floats and doubles */ -rpc_ fabs_(rpc_ x) { -#ifdef REAL_32 - double fabsd = fabs(double(x)); - float fabss; - fabss = fabsd; - return fabss; -#elif REAL_128 - double fabsd = fabs(double(x)); - __float128 fabsq; - fabsq = fabsd; - return fabsq; -#else - return fabs(x); -#endif -} - -/** Returns true if all entries in col are less than small in abs value */ -bool check_col_small(ipc_ idx, ipc_ from, ipc_ to, rpc_ const* a, - ipc_ lda, rpc_ small) { - bool check = true; - for(ipc_ c=from; c=to) return -1; - ipc_ best_idx=from; rpc_ best_val=fabs(a[from*lda]); - for(ipc_ idx=from+1; idx best_val) { - best_idx = idx; - best_val = fabs(a[idx*lda]); - } - return best_idx; -} - -/** Performs symmetric swap of col1 and col2 in lower triangle */ -// FIXME: remove n only here for debug -void swap_cols(ipc_ col1, ipc_ col2, ipc_ m, ipc_ n, ipc_* perm, rpc_* a, - ipc_ lda, ipc_ nleft, rpc_* aleft, ipc_ ldleft) { - if(col1 == col2) return; // No-op - - // Ensure col1 < col2 - if(col2::infinity(); -#endif - d[3] = (a11*detscale)/detpiv; - //printf("t2 %e < %e?\n", std::max(maxp, maxt), small); - if(std::max(maxp, maxt) < small) return true; // Rest of col small - rpc_ x1 = fabs(d[0])*maxt + fabs(d[1])*maxp; - rpc_ x2 = fabs(d[1])*maxt + fabs(d[3])*maxp; - //printf("t3 %e < %e?\n", std::max(x1, x2), 1.0/u); - return ( u*std::max(x1, x2) < 1.0 ); -} - -/** Applies the 2x2 pivot to rest of block column */ -void apply_2x2(ipc_ nelim, ipc_ m, rpc_* a, ipc_ lda, rpc_* ld, - ipc_ ldld, rpc_* d) { - /* Set diagonal block to identity */ - rpc_* a1 = &a[nelim*lda]; - rpc_* a2 = &a[(nelim+1)*lda]; - a1[nelim] = 1.0; - a1[nelim+1] = 0.0; - a2[nelim+1] = 1.0; - /* Extract D^-1 values */ - rpc_ d11 = d[2*nelim]; - rpc_ d21 = d[2*nelim+1]; - rpc_ d22 = d[2*nelim+3]; - /* Divide through, preserving copy in ld */ - for(ipc_ r=nelim+2; r= u*maxp ) { - //printf("1x1 pivot\n"); - swap_cols(p, nelim, m, n, perm, a, lda, nleft, aleft, ldleft); - d[2*nelim] = 1 / a[nelim*lda+nelim]; - d[2*nelim+1] = 0.0; - apply_1x1(nelim, m, a, lda, ld, ldld, d); - host_gemm(OP_N, OP_T, m-nelim-1, n-nelim-1, one_integer, minus_one_val, - &a[nelim*lda+nelim+1], lda, &ld[nelim+1], ldld, one_val, - &a[(nelim+1)*lda+nelim+1], lda); // update trailing mat - nelim += 1; - break; - } - } - if(p>=n) { - // Pivot search failed - - // Try 1x1 pivot on p=nelim as last resort (we started at p=nelim+1) - p = nelim; - rpc_ maxp = find_rc_abs_max_exclude(p, nelim, m, a, lda, -1); - if( fabs_(a[p*lda+p]) >= u*maxp ) { - //printf("1x1 pivot %d\n", p); - swap_cols(p, nelim, m, n, perm, a, lda, nleft, aleft, ldleft); - d[2*nelim] = 1 / a[nelim*lda+nelim]; - d[2*nelim+1] = 0.0; - apply_1x1(nelim, m, a, lda, ld, ldld, d); - host_gemm(OP_N, OP_T, m-nelim-1, n-nelim-1, one_integer, minus_one_val, - &a[nelim*lda+nelim+1], lda, &ld[nelim+1], ldld, one_val, - &a[(nelim+1)*lda+nelim+1], lda); // update trailing mat - nelim += 1; - } else { - // That didn't work either. No more pivots to be found - //printf("Out of pivots\n"); - break; - } - } - } - /*printf("==== EXIT ====\n"); - for(int r=0; r n) - gemv(OP_N, m-n, n, minus_one_val, &l[n], ldl, x, one_integer, one_val, &x[n], one_integer); - } else { - host_trsm(SIDE_LEFT, FILL_MODE_LWR, OP_N, DIAG_UNIT, n, nrhs, - one_val, l, ldl, x, ldx); - if(m > n) - host_gemm(OP_N, OP_N, m-n, nrhs, n, minus_one_val, &l[n], - ldl, x, ldx, one_val, &x[n], ldx); - } -} - -void ldlt_tpp_solve_diag(ipc_ n, rpc_ const* d, rpc_* x) { - for(ipc_ i=0; i(d[2*i+2]))) { -#else - if(i+1 n) - gemv(OP_T, m-n, n, minus_one_val, &l[n], ldl, &x[n], one_integer, one_val, x, one_integer); - host_trsv(FILL_MODE_LWR, OP_T, DIAG_UNIT, n, l, ldl, x, one_integer); - } else { - if(m > n) - host_gemm(OP_T, OP_N, n, nrhs, m-n, minus_one_val, &l[n], ldl, - &x[n], ldx, one_val, x, ldx); - host_trsm(SIDE_LEFT, FILL_MODE_LWR, OP_T, DIAG_UNIT, n, nrhs, - one_val, l, ldl, x, ldx); - } -} - -}}} /* end of namespace galahad::ssids::cpu */ diff --git a/src/ssids/makemaster b/src/ssids/makemaster deleted file mode 100644 index 8f95ea1e7e..0000000000 --- a/src/ssids/makemaster +++ /dev/null @@ -1,1181 +0,0 @@ -# Main body of the installation makefile for the SPRAL SSIDS package -# SPRAL SSIDS was developed as part of SPRAL by Jonathan Hogg (now at Apple) -# and is available under a BSD licence as part of GALAHAD - -# Nick Gould, for GALAHAD production -# This version: 2025-08-31 - -SHELL = /bin/$(BINSHELL) - -ifeq "$(PRECIS)" "single_64" - DPREC = -DREAL_32 -DINTEGER_64 $(QUADREAL) - METIS_64 = _64 -else ifeq "$(PRECIS)" "quadruple_64" - DPREC = -DREAL_128 -DINTEGER_64 $(QUADREAL) - METIS_64 = _64 -else ifeq "$(PRECIS)" "double_64" - DPREC = -DINTEGER_64 $(QUADREAL) - METIS_64 = _64 -else ifeq "$(PRECIS)" "single" - DPREC = -DREAL_32 $(QUADREAL) - METIS_64 = -else ifeq "$(PRECIS)" "quadruple" - DPREC = -DREAL_128 $(QUADREAL) - METIS_64 = -else - DPREC = $(QUADREAL) - METIS_64 = -endif - -ifeq "$(HWLOC)" "un" - DHWLOC = -DSPRAL_NO_HWLOC -else - DHWLOC = -DSPRAL_HAVE_HWLOC -endif - -ifeq "$(GETCPU)" "un" - DGETCPU = -DSPRAL_NO_SCHED_GETCPU -else - DGETCPU = -DSPRAL_HAVE_SCHED_GETCPU -endif - -ifeq "$(MULTIVERSIONS)" "yes" - MULTI = -DMULTIPRECISION -else - MULTI = -endif - -CPPDEFINES = $(DPREC) $(MULTI) - -GALINCLUDE = $(GALAHAD)/include - -VALGRIND = -v --tool=memcheck --leak-check=full --show-reachable=yes \ ---track-origins=yes -s - -# compiler flags - -FFLAGS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) \ - $(CPPDEFINES) -I $(GALINCLUDE) -FFLAGSS = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(SPECIAL) \ - $(CPPDEFINES) -I $(GALINCLUDE) -FFLAGSN = $(BASIC) $(NOOPTIMIZATION) $(DEBUG) $(MODULES) $(F90) \ - $(CPPDEFINES) -I $(GALINCLUDE) -FFLAGS77 = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(USUAL) \ - $(CPPDEFINES) -I $(GALINCLUDE) -FFLAGS77S = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F77) $(SPECIAL) \ - $(CPPDEFINES) -I $(GALINCLUDE) -FFLAGSOMP = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) $(USUAL) \ - $(SOMP) $(CPPDEFINES) -I $(GALINCLUDE) -FFLAGSNOMP = $(BASIC) $(OPTIMIZATION) $(DEBUG) $(MODULES) $(F90) \ - $(SOMP) $(CPPDEFINES) -I $(GALINCLUDE) - -# C compiler flags - -CFLAGS = $(CCBASIC) $(OPTIMIZATION) $(CCDEBUG) \ - $(CPPDEFINES) -I $(GALAHAD)/include -I ./include -CFLAGSN = $(CCBASIC) $(NOOPTIMIZATION) $(CCDEBUG) \ - $(CPPDEFINES) -I $(GALAHAD)/include -I ./include - -# C++ compiler flags - -CXXFLAGSOMP = $(CXXBASIC) $(OPTIMIZATION) $(CXXDEBUG) $(SOMP) \ - $(CPPDEFINES) $(DHWLOC) $(DGETCPU) -I $(GALINCLUDE) -CXXFLAGSNOMP = $(CXXBASIC) $(NOOPTIMIZATION) $(CXXDEBUG) $(SOMP) \ - $(CPPDEFINES) $(DHWLOC) $(DGETCPU) -I $(GALINCLUDE) - -# CUDA compiler flags - -#CUDAFLAGS = -arch=$(CUDAARCH) -code=$(CUDACODE) $(CUDABASIC) \ -# $(OPTIMIZATION) -I $(GALINCLUDE) -#CUDAFLAGSN = -arch=$(CUDAARCH) -code=$(CUDACODE) $(CUDABASIC) \ -# $(NOOPTIMIZATION) -I$(GALINCLUDE) - -CUDAFLAGS = $(CUDABASIC) $(CUDAOPTIMIZATION) -I$(GALINCLUDE) -CUDAFLAGSN = $(CUDABASIC) $(CUDANOOPTIMIZATION) -I$(GALINCLUDE) - -# linking and run flags - -RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) -RUNFFLAGSCUDA = $(OPTIMIZATION) $(MODULES) -RUNFFLAGSOMP = $(OPTIMIZATION) $(DEBUG) $(MODULES) $(SOMP) - -# names of random libraries - -LG = $(OBJ)/libgalahad.a -LGS = $(OBJS)/libgalahad.a -LGD = $(OBJD)/libgalahad.a -LGQ = $(OBJQ)/libgalahad.a -LGS64 = $(OBJS64)/libgalahad.a -LGD64 = $(OBJD64)/libgalahad.a -LGQ64 = $(OBJQ64)/libgalahad.a - -CLG = $(OBJ)/libgalahad_c.a -CLGS = $(OBJS)/libgalahad_c.a -CLGD = $(OBJD)/libgalahad_c.a -CLGQ = $(OBJQ)/libgalahad_c.a -CLGS64 = $(OBJS64)/libgalahad_c.a -CLGD64 = $(OBJD64)/libgalahad_c.a -CLGQ64 = $(OBJQ64)/libgalahad_c.a - -#RLG = $(OBJ)/libgalahad_spral.a -#RLGS = $(OBJS)/libgalahad_spral.a -#RLGD = $(OBJD)/libgalahad_spral.a -#RLGQ = $(OBJQ)/libgalahad_spral.a -#RLGS64 = $(OBJS64)/libgalahad_spral.a -#RLGD64 = $(OBJD64)/libgalahad_spral.a -#RLGQ64 = $(OBJQ64)/libgalahad_spral.a - -RLG = $(LG) -RLGS = $(LGS) -RLGD = $(LGD) -RLGQ = $(LGQ) -RLGS64 = $(LGS64) -RLGD64 = $(LGD64) -RLGQ64 = $(LGQ64) - -# Libraries used - -ifeq "$(METIS_64)" "_64" -# LIBS = -L$(OBJ) $(METIS64) $(LAPACK64) $(BLAS64) -lgalahad $(METIS64) $(HSL) - LIBS = -L$(OBJ) -lgalahad $(LAPACK) $(BLAS) \ - $(METIS464ND) $(METIS564ND) $(HSL) -lstdc++ -lhwloc -else - LIBS = -L$(OBJ) -lgalahad $(LAPACK) $(BLAS) \ - $(METIS4ND) $(METIS5ND) $(HSL) -lstdc++ -lhwloc -endif - -PLIBS = $(LIBS) -lgalahad_problem -#CLIBS = -lgalahad_c -lhsl_c $(LIBS) -CLIBS = -lgalahad_c $(LIBS) - -# Archive manipulation strings - -RMARFILE = $(GALAHAD)/bin/rmarfile $(AR) $(GREP) $(LG) -RMOBFILE = $(GALAHAD)/bin/rmobfile $(RM) $(OBJ) - -#RARR = $(AR) $(ARREPFLAGS) $(RLG) -#RRMARFILE = $(GALAHAD)/bin/rmarfile $(AR) $(GREP) $(RLG) - -RARR = $(AR) $(ARREPFLAGS) $(LG) -RRMARFILE = $(GALAHAD)/bin/rmarfile $(AR) $(GREP) $(LG) - -CARR = $(AR) $(ARREPFLAGS) $(CLG) -CRMARFILE = $(GALAHAD)/bin/rmarfile $(AR) $(GREP) $(CLG) - -# sed scripts - -BLASLAPACKSEDS = $(GALAHAD)/seds/blaslapack_$(PRECIS).sed - -# strings - -SUCC = precision version) compiled successfully - -# compilation agenda - -SSIDSSS = $(SSIDSS) $(OBJS)/ssidss_single.o -SSIDSDS = $(SSIDSD) $(OBJD)/ssidss_double.o -SSIDSQS = $(SSIDSQ) $(OBJQ)/ssidss_quadruple.o -SSIDSST = $(SSIDSS) $(OBJS)/ssidst_single.o -SSIDSST2 = $(SSIDSS) $(OBJS)/ssidst2_single.o -SSIDSDT = $(SSIDSD) $(OBJD)/ssidst_double.o -SSIDSDT2 = $(SSIDSD) $(OBJD)/ssidst2_double.o -SSIDSQT = $(SSIDSQ) $(OBJQ)/ssidst_quadruple.o -SSIDSQT2 = $(SSIDSQ) $(OBJQ)/ssidst2_quadruple.o - -SSIDSSS64 = $(SSIDSS64) $(OBJS64)/ssidss_single_64.o -SSIDSDS64 = $(SSIDSD64) $(OBJD64)/ssidss_double_64.o -SSIDSQS64 = $(SSIDSQ64) $(OBJQ64)/ssidss_quadruple_64.o -SSIDSST64 = $(SSIDSS64) $(OBJS64)/ssidst_single_64.o -SSIDSST264 = $(SSIDSS64) $(OBJS64)/ssidst2_single_64.o -SSIDSDT64 = $(SSIDSD64) $(OBJD64)/ssidst_double_64.o -SSIDSDT264 = $(SSIDSD64) $(OBJD64)/ssidst2_double_64.o -SSIDSQT64 = $(SSIDSQ64) $(OBJQ64)/ssidst_quadruple_64.o -SSIDSQT264 = $(SSIDSQ64) $(OBJQ64)/ssidst2_quadruple_64.o - -RSSIDSSS = $(OBJS)/ssidss_single.o -L$(OBJS) $(LIBS) -RSSIDSDS = $(OBJD)/ssidss_double.o -L$(OBJD) $(LIBS) -RSSIDSQS = $(OBJQ)/ssidss_quadruple.o -L$(OBJQ) $(LIBS) -RSSIDSST = $(OBJS)/ssidst_single.o -L$(OBJS) $(LIBS) -RSSIDSST2 = $(OBJS)/ssidst2_single.o -L$(OBJS) $(LIBS) -RSSIDSDT = $(OBJD)/ssidst_double.o -L$(OBJD) $(LIBS) -RSSIDSDT2 = $(OBJD)/ssidst2_double.o -L$(OBJD) $(LIBS) -RSSIDSQT = $(OBJQ)/ssidst_quadruple.o -L$(OBJQ) $(LIBS) -RSSIDSQT2 = $(OBJQ)/ssidst2_quadruple.o -L$(OBJQ) $(LIBS) - -RSSIDSSS64 = $(OBJS64)/ssidss_single_64.o -L$(OBJS64) $(LIBS) -RSSIDSDS64 = $(OBJD64)/ssidss_double_64.o -L$(OBJD64) $(LIBS) -RSSIDSQS64 = $(OBJQ64)/ssidss_quadruple_64.o -L$(OBJQ64) $(LIBS) -RSSIDSST64 = $(OBJS64)/ssidst_single_64.o -L$(OBJS64) $(LIBS) -RSSIDSST264 = $(OBJS64)/ssidst2_single_64.o -L$(OBJS64) $(LIBS) -RSSIDSDT64 = $(OBJD64)/ssidst_double_64.o -L$(OBJD64) $(LIBS) -RSSIDSDT264 = $(OBJD64)/ssidst2_double_64.o -L$(OBJD64) $(LIBS) -RSSIDSQT64 = $(OBJQ64)/ssidst_quadruple_64.o -L$(OBJQ64) $(LIBS) -RSSIDSQT264 = $(OBJQ64)/ssidst2_quadruple_64.o -L$(OBJQ64) $(LIBS) - -# test agenda for C interfaces - -SSIDSCST = $(SSIDSCS) $(TESTDEPS) $(OBJS)/ssidsct_single.o -SSIDSCDT = $(SSIDSCD) $(TESTDEPS) $(OBJD)/ssidsct_double.o -SSIDSCQT = $(SSIDSCQ) $(TESTDEPS) $(OBJQ)/ssidsct_quadruple.o -SSIDSCST64 = $(SSIDSCS64) $(TESTDEPS) $(OBJS64)/ssidsct_single_64.o -SSIDSCDT64 = $(SSIDSCD64) $(TESTDEPS) $(OBJD64)/ssidsct_double_64.o -SSIDSCQT64 = $(SSIDSCQ64) $(TESTDEPS) $(OBJQ64)/ssidsct_quadruple_64.o - -SSIDSCSTF = $(SSIDSCS) $(TESTDEPS) $(OBJS)/ssidsctf_single.o -SSIDSCDTF = $(SSIDSCD) $(TESTDEPS) $(OBJD)/ssidsctf_double.o -SSIDSCQTF = $(SSIDSCQ) $(TESTDEPS) $(OBJQ)/ssidsctf_quadruple.o -SSIDSCSTF64 = $(SSIDSCS64) $(TESTDEPS) $(OBJS64)/ssidsctf_single_64.o -SSIDSCDTF64 = $(SSIDSCD64) $(TESTDEPS) $(OBJD64)/ssidsctf_double_64.o -SSIDSCQTF64 = $(SSIDCCQ64) $(TESTDEPS) $(OBJQ64)/ssidsctf_quadruple_64.o - -RSSIDSCST = $(OBJS)/ssidsct_single.o -L$(OBJS) $(CLIBS) -RSSIDSCSTF = $(OBJS)/ssidsctf_single.o -L$(OBJS) $(CLIBS) -RSSIDSCDT = $(OBJD)/ssidsct_double.o -L$(OBJD) $(CLIBS) -RSSIDSCDTF = $(OBJD)/ssidsctf_double.o -L$(OBJD) $(CLIBS) -RSSIDSCQT = $(OBJQ)/ssidsct_quadruple.o -L$(OBJQ) $(CLIBS) -RSSIDSCQTF = $(OBJQ)/ssidsctf_quadruple.o -L$(OBJQ) $(CLIBS) -RSSIDSCST64 = $(OBJS64)/ssidsct_single_64.o -L$(OBJS64) $(CLIBS) -RSSIDSCSTF64 = $(OBJS64)/ssidsctf_single_64.o -L$(OBJS64) $(CLIBS) -RSSIDSCDT64 = $(OBJD64)/ssidsct_double_64.o -L$(OBJD64) $(CLIBS) -RSSIDSCDTF64 = $(OBJD64)/ssidsctf_double_64.o -L$(OBJD64) $(CLIBS) -RSSIDSCQT64 = $(OBJQ64)/ssidsct_quadruple_64.o -L$(OBJQ64) $(CLIBS) -RSSIDSCQTF64 = $(OBJQ64)/ssidsctf_quadruple_64.o -L$(OBJQ64) $(CLIBS) - -SPRALRBS = mu rb -SPRALRBD = mu rb -SPRALRBQ = mu rb -SPRALRBS64 = mu rb -SPRALRBD64 = mu rb -SPRALRBQ64 = mu rb - -SSIDSS = basics $(SPRALRBS) ms mo hw $(RLGS)(omp.o) \ - $(RLGS)(SymbolicSubtree.o) $(RLGS)(NumericSubtree_single.o) \ - $(RLGS)(cholesky_single.o) $(RLGS)(ldlt_app_single.o) \ - $(RLGS)(ldlt_nopiv_single.o) $(RLGS)(ldlt_tpp_single.o) \ - $(RLGS)(wrappers_single.o) $(RLGS)(ThreadStats.o) \ - $(RLGS)(types_single.o) $(RLGS)(subtree_single.o) \ - $(RLGS)(cpu_iface_single.o) $(RLGS)(cpu_subtree_single.o) \ - $(RLGS)(contrib_iface_single.o) $(RLGS)(ssids_single.o) - -SSIDSD = basics $(SPRALRBD) ms mo hw $(RLGD)(omp.o) \ - $(RLGD)(SymbolicSubtree.o) $(RLGD)(NumericSubtree_double.o) \ - $(RLGD)(cholesky_double.o) $(RLGD)(ldlt_app_double.o) \ - $(RLGD)(ldlt_nopiv_double.o) $(RLGD)(ldlt_tpp_double.o) \ - $(RLGD)(wrappers_double.o) $(RLGD)(ThreadStats.o) \ - $(RLGD)(types_double.o) $(RLGD)(subtree_double.o) \ - $(RLGD)(cpu_iface_double.o) $(RLGD)(cpu_subtree_double.o) \ - $(RLGD)(contrib_iface_double.o) $(RLGD)(ssids_double.o) - -SSIDSQ = basics $(SPRALRBQ) ms mo hw $(RLGQ)(omp.o) \ - $(RLGQ)(SymbolicSubtree.o) $(RLGQ)(NumericSubtree_quadruple.o) \ - $(RLGQ)(cholesky_quadruple.o) $(RLGQ)(ldlt_app_quadruple.o) \ - $(RLGQ)(ldlt_nopiv_quadruple.o) $(RLGQ)(ldlt_tpp_quadruple.o) \ - $(RLGQ)(wrappers_quadruple.o) $(RLGQ)(ThreadStats.o) \ - $(RLGQ)(types_quadruple.o) $(RLGQ)(subtree_quadruple.o) \ - $(RLGQ)(cpu_iface_quadruple.o) $(RLGQ)(cpu_subtree_quadruple.o) \ - $(RLGQ)(contrib_iface_quadruple.o) $(RLGQ)(ssids_quadruple.o) - -SSIDSS64 = basics $(SPRALRBS64) ms mo hw $(RLGS64)(omp.o) \ - $(RLGS64)(SymbolicSubtree.o) $(RLGS64)(NumericSubtree_single_64.o) \ - $(RLGS64)(cholesky_single_64.o) $(RLGS64)(ldlt_app_single_64.o) \ - $(RLGS64)(ldlt_nopiv_single_64.o) $(RLGS64)(ldlt_tpp_single_64.o) \ - $(RLGS64)(wrappers_single_64.o) $(RLGS64)(ThreadStats.o) \ - $(RLGS64)(types_single_64.o) $(RLGS64)(subtree_single_64.o) \ - $(RLGS64)(cpu_iface_single_64.o) $(RLGS64)(cpu_subtree_single_64.o) \ - $(RLGS64)(contrib_iface_single_64.o) $(RLGS64)(ssids_single_64.o) - -SSIDSD64 = basics $(SPRALRBD64) ms mo hw $(RLGD64)(omp.o) \ - $(RLGD64)(SymbolicSubtree.o) $(RLGD64)(NumericSubtree_double_64.o) \ - $(RLGD64)(cholesky_double_64.o) $(RLGD64)(ldlt_app_double_64.o) \ - $(RLGD64)(ldlt_nopiv_double_64.o) $(RLGD64)(ldlt_tpp_double_64.o) \ - $(RLGD64)(wrappers_double_64.o) $(RLGD64)(ThreadStats.o) \ - $(RLGD64)(types_double_64.o) $(RLGD64)(subtree_double_64.o) \ - $(RLGD64)(cpu_iface_double_64.o) $(RLGD64)(cpu_subtree_double_64.o) \ - $(RLGD64)(contrib_iface_double_64.o) $(RLGD64)(ssids_double_64.o) - -SSIDSQ64 = basics $(SPRALRBQ64) ms mo hw $(RLGQ64)(omp.o) \ - $(RLGQ64)(SymbolicSubtree.o) $(RLGQ64)(NumericSubtree_quadruple_64.o) \ - $(RLGQ64)(cholesky_quadruple_64.o) $(RLGQ64)(ldlt_app_quadruple_64.o) \ - $(RLGQ64)(ldlt_nopiv_quadruple_64.o) \ - $(RLGQ64)(ldlt_tpp_quadruple_64.o) \ - $(RLGQ64)(wrappers_quadruple_64.o) $(RLGQ64)(ThreadStats.o) \ - $(RLGQ64)(types_quadruple_64.o) $(RLGQ64)(subtree_quadruple_64.o) \ - $(RLGQ64)(cpu_iface_quadruple_64.o) \ - $(RLGQ64)(cpu_subtree_quadruple_64.o) \ - $(RLGQ64)(contrib_iface_quadruple_64.o) $(RLGQ64)(ssids_quadruple_64.o) - -SSIDSCS = $(SSIDSS) nodend_c $(CLGS)(ssids_ciface_single.o) -SSIDSCD = $(SSIDSD) nodend_c $(CLGD)(ssids_ciface_double.o) -SSIDSCQ = $(SSIDSQ) nodend_c $(CLGQ)(ssids_ciface_quadruple.o) -SSIDSCS64 = $(SSIDSS64) nodend_c $(CLGS64)(ssids_ciface_single_64.o) -SSIDSCD64 = $(SSIDSD64) nodend_c $(CLGD64)(ssids_ciface_double_64.o) -SSIDSCQ64 = $(SSIDSQ64) nodend_c $(CLGQ64)(ssids_ciface_quadruple_64.o) - -# main compilations and runs - -all: ssids - -# ssids - -ssids_silent: ssids_silent_$(PRECIS) -ssids_silent_single: $(SSIDSS) - $(RANLIB) $(RLGS) -ssids_silent_double: $(SSIDSD) - $(RANLIB) $(RLGD) -ssids_silent_quadruple: $(SSIDSQ) - $(RANLIB) $(RLGQ) -ssids_silent_single_64: $(SSIDSS64) - $(RANLIB) $(RLGS64) -ssids_silent_double_64: $(SSIDSD64) - $(RANLIB) $(RLGD64) -ssids_silent_quadruple_64: $(SSIDSQ64) - $(RANLIB) $(RLGQ64) - -ssids: ssids_$(PRECIS) - @printf ' %-21s\n' "GALAHAD: SSIDS ($(PRECIS) $(SUCC)" -ssids_single: $(SSIDSS) - $(RANLIB) $(RLGS) -ssids_double: $(SSIDSD) - $(RANLIB) $(RLGD) -ssids_quadruple: $(SSIDSQ) - $(RANLIB) $(RLGQ) -ssids_single_64: $(SSIDSS64) - $(RANLIB) $(RLGS64) -ssids_double_64: $(SSIDSD64) - $(RANLIB) $(RLGD64) -ssids_quadruple_64: $(SSIDSQ64) - $(RANLIB) $(RLGQ64) - -ssids_ciface: ssids_ciface_$(PRECIS) - @printf ' %-21s\n' "SSIDS C routines ($(PRECIS) $(SUCC)" -ssids_ciface_silent: ssids_ciface_$(PRECIS) -ssids_ciface_single: $(SSIDSCS) -ssids_ciface_double: $(SSIDSCD) -ssids_ciface_quadruple: $(SSIDSCQ) -ssids_ciface_single_64: $(SSIDSCS64) -ssids_ciface_double_64: $(SSIDSCD64) -ssids_ciface_quadruple_64: $(SSIDSCQ64) - -# spralrb - -spralrb_silent: spralrb_silent_$(PRECIS) -spralrb_silent_single: $(SPRALRBS) - $(RANLIB) $(RLGS) -spralrb_silent_double: $(SPRALRBD) - $(RANLIB) $(RLGD) -spralrb_silent_quadruple: $(SPRALRBQ) - $(RANLIB) $(RLGQ) -spralrb_silent_single_64: $(SPRALRBS64) - $(RANLIB) $(RLGS64) -spralrb_silent_double_64: $(SPRALRBD64) - $(RANLIB) $(RLGD64) -spralrb_silent_quadruple_64: $(SPRALRBQ64) - $(RANLIB) $(RLGQ64) - -spralrb: spralrb_$(PRECIS) - @printf ' %-21s\n' "GALAHAD: SPRALRB ($(PRECIS) $(SUCC)" -spralrb_single: $(SPRALRBS) - $(RANLIB) $(RLGS) -spralrb_double: $(SPRALRBD) - $(RANLIB) $(RLGD) -spralrb_quadruple: $(SPRALRBQ) - $(RANLIB) $(RLGQ) -spralrb_single_64: $(SPRALRBS64) - $(RANLIB) $(RLGS64) -spralrb_double_64: $(SPRALRBD64) - $(RANLIB) $(RLGD64) -spralrb_quadruple_64: $(SPRALRBQ64) - $(RANLIB) $(RLGQ64) - -# run spec-sheet example tests - -ssidsss: $(SSIDSSS) - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSSS) -# - ../ssids/run_ssids < ../ssids/ssidss.data - - ../ssids/run_ssids < ../ssids/ssidss.data \ - > ../ssids/ssidss.output 2>&1 - cat ../ssids/ssidss.output - rm ../ssids/run_ssids - -ssidsds: $(SSIDSDS) - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSDS) -# - ../ssids/run_ssids < ../ssids/ssidss.data - - ../ssids/run_ssids < ../ssids/ssidss.data \ - > ../ssids/ssidsds.output 2>&1 - cat ../ssids/ssidsds.output - rm ../ssids/run_ssids - -ssidsqs: $(SSIDSQS) - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSQS) -# - ../ssids/run_ssids < ../ssids/ssidss.data - - ../ssids/run_ssids < ../ssids/ssidss.data \ - > ../ssids/ssidsds.output 2>&1 - cat ../ssids/ssidsds.output - rm ../ssids/run_ssids - -ssidsds_valgrind: $(SSIDSDS) - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSDS) - - valgrind $(VALGRIND) ../ssids/run_ssids < ../ssids/ssidss.data - rm ../ssids/run_ssids - -ssidsss_64: $(SSIDSSS64) - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSSS64) -# - ../ssids/run_ssids < ../ssids/ssidss.data - - ../ssids/run_ssids < ../ssids/ssidss.data \ - > ../ssids/ssidss_64.output 2>&1 - cat ../ssids/ssidss_64.output - rm ../ssids/run_ssids - -ssidsds_64: $(SSIDSDS64) - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSDS64) -# - ../ssids/run_ssids < ../ssids/ssidss.data - - ../ssids/run_ssids < ../ssids/ssidss.data \ - > ../ssids/ssidsds_64.output 2>&1 - cat ../ssids/ssidsds_64.output - rm ../ssids/run_ssids - -ssidsqs_64: $(SSIDSDQ64) - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSDQ64) - - ../ssids/run_ssids < ../ssids/ssidss.data \ - > ../ssids/ssidsds_64.output 2>&1 - cat ../ssids/ssidsds_64.output - rm ../ssids/run_ssids - -ssidsds_64_valgrind: $(SSIDSDS64) - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSDS64) - - valgrind $(VALGRIND) ../ssids/run_ssids < ../ssids/ssidss.data - rm ../ssids/run_ssids - -# run full tests - -ssidsst: $(SSIDSST) - echo " Exhaustive test of subroutine interface to ssids" - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSST) -# - ../ssids/run_ssids < ../ssids/ssidss.data - - ../ssids/run_ssids > ../ssids/ssidst.output 2>&1 - cat ../ssids/ssidst.output - rm ../ssids/run_ssids - -ssidsst2: $(SSIDSST2) - echo " Exhaustive test of subroutine interface to ssids" - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids2 $(RSSIDSST2) -# - ../ssids/run_ssids2 - - ../ssids/run_ssids2 > ../ssids/ssidst2.output 2>&1 - cat ../ssids/ssidst2.output - rm ../ssids/run_ssids2 - -ssidsdt: $(SSIDSDT) - echo " Exhaustive test of subroutine interface to ssids" - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSDT) -# - ../ssids/run_ssids - - ../ssids/run_ssids > ../ssids/ssidsdt.output 2>&1 - cat ../ssids/ssidsdt.output - rm ../ssids/run_ssids - -ssidsdt2: $(SSIDSDT2) - echo " Exhaustive test of subroutine interface to ssids" - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids2 $(RSSIDSDT2) -# - ../ssids/run_ssids2 - - ../ssids/run_ssids2 > ../ssids/ssidsdt2.output 2>&1 - cat ../ssids/ssidsdt2.output - rm ../ssids/run_ssids2 - -ssidsqt: $(SSIDSQT) - echo " Exhaustive test of subroutine interface to ssids" - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSQT) -# - ../ssids/run_ssids - - ../ssids/run_ssids > ../ssids/ssidsqt.output 2>&1 - cat ../ssids/ssidsqt.output - rm ../ssids/run_ssids - -ssidsqt2: $(SSIDSQT2) - echo " Exhaustive test of subroutine interface to ssids" - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids2 $(RSSIDSQT2) -# - ../ssids/run_ssids2 - - ../ssids/run_ssids2 > ../ssids/ssidsqt2.output 2>&1 - cat ../ssids/ssidsqt2.output - rm ../ssids/run_ssids - -ssidsst_64: $(SSIDSST64) - echo " Exhaustive test of subroutine interface to ssids" - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSST64) -# - ../ssids/run_ssids < ../ssids/ssidss.data - - ../ssids/run_ssids > ../ssids/ssidst_64.output 2>&1 - cat ../ssids/ssidst_64.output - rm ../ssids/run_ssids - -ssidsst2_64: $(SSIDSST264) - echo " Exhaustive test of subroutine interface to ssids" - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids2 $(RSSIDSST264) -# - ../ssids/run_ssids2 < ../ssids/ssidss.data - - ../ssids/run_ssids2 > ../ssids/ssidst2_64.output 2>&1 - cat ../ssids/ssidst2_64.output - rm ../ssids/run_ssids2 - -ssidsdt_64: $(SSIDSDT64) - echo " Exhaustive test of subroutine interface to ssids" - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSDT64) -# - ../ssids/run_ssids - - ../ssids/run_ssids > ../ssids/ssidsdt_64.output 2>&1 - cat ../ssids/ssidsdt_64.output - rm ../ssids/run_ssids - -ssidsdt2_64: $(SSIDSDT264) - echo " Exhaustive test of subroutine interface to ssids" - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids2 $(RSSIDSDT264) -# - ../ssids/run_ssids2 - - ../ssids/run_ssids2 > ../ssids/ssidsdt2_64.output 2>&1 - cat ../ssids/ssidsdt2_64.output - rm ../ssids/run_ssids2 - -ssidsqt_64: $(SSIDSQT64) - echo " Exhaustive test of subroutine interface to ssids" - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSQT64) -# - ../ssids/run_ssids - - ../ssids/run_ssids > ../ssids/ssidsdt_64.output 2>&1 - cat ../ssids/ssidsdt_64.output - rm ../ssids/run_ssids - -ssidsqt2_64: $(SSIDSQT264) - echo " Exhaustive test of subroutine interface to ssids" - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids2 $(RSSIDSQT264) -# - ../ssids/run_ssids2 - - ../ssids/run_ssids2 > ../ssids/ssidsdt2_64.output 2>&1 - cat ../ssids/ssidsdt2_64.output - rm ../ssids/run_ssids2 - -ssidsdt_gdb: $(SSIDSDT) - echo " Exhaustive test of subroutine interface to ssids" - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSDT) - - gdb $(GDB) ./run_ssids - rm ../ssids/run_ssids - -ssidsdt_valgrind: $(SSIDSDT) - echo " Exhaustive test of subroutine interface to ssids" - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSDT) -# - ../ssids/run_ssids - - valgrind $(VALGRIND) ../ssids/run_ssids - rm ../ssids/run_ssids - -# run debugging tests - -ssidsdt_64_gdb: $(SSIDSDT64) - echo " Exhaustive test of subroutine interface to ssids" - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSDT64) - - gdb $(GDB) ./run_ssids - rm ../ssids/run_ssids - -ssidsdt_64_valgrind: $(SSIDSDT64) - echo " Exhaustive test of subroutine interface to ssids" - cd ../ssids ; $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - -o run_ssids $(RSSIDSDT64) -# - ../ssids/run_ssids - - valgrind $(VALGRIND) ../ssids/run_ssids - rm ../ssids/run_ssids - -# run full (comprehensive) C example tests - -ssidscst: $(SSIDSCST) - echo "" - echo " Exhaustive test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCST) - - ./run_ssids > ssidscst.output 2>&1 - cat ssidscst.output - rm ./run_ssids - -ssidscstf: $(SSIDSCSTF) - echo "" - echo " Exhaustive test of Fortran function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCSTF) - - ./run_ssids > ssidscstf.output 2>&1 - cat ssidscstf.output - rm ./run_ssids - -ssidscdt: $(SSIDSCDT) - echo "" - echo " Exhaustive test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCDT) - - ./run_ssids > ssidsdt.output 2>&1 - cat ssidsdt.output - rm ./run_ssids - -ssidscdtf: $(SSIDSCDTF) - echo "" - echo " Exhaustive test of Fortran function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCDTF) - - ./run_ssids -# - ./run_ssids > ssidsdtf.output 2>&1 -# cat ssidsdtf.output - rm ./run_ssids - -ssidscqt: $(SSIDSCQT) - echo "" - echo " Exhaustive test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCQT) - - ./run_ssids > ssidscqt.output 2>&1 - cat ssidscqt.output - rm ./run_ssids - -ssidscqtf: $(SSIDSCQTF) - echo "" - echo " Exhaustive test of Fortran function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCQTF) - - ./run_ssids > ssidscqtf.output 2>&1 - cat ssidscqtf.output - rm ./run_ssids - -ssidscst_64: $(SSIDSCST64) - echo "" - echo " Exhaustive test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCST64) - - ./run_ssids > ssidscst64.output 2>&1 - cat ssidscst64.output - rm ./run_ssids - -ssidscstf_64: $(SSIDSCSTF64) - echo "" - echo " Exhaustive test of Fortran function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCSTF64) - - ./run_ssids > ssidscstf64.output 2>&1 - cat ssidscstf64.output - rm ./run_ssids - -ssidscdt_64: $(SSIDSCDT64) - echo "" - echo " Exhaustive test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCDT64) - - ./run_ssids > ssidscdt64.output 2>&1 - cat ssidscdt64.output - rm ./run_ssids - -ssidscdtf_64: $(SSIDSCDTF64) - echo "" - echo " Exhaustive test of Fortran function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCDTF64) - - ./run_ssids > ssidscdtf64.output 2>&1 - cat ssidscdtf64.output - rm ./run_ssids - -ssidscqt_64: $(SSIDSCQT64) - echo "" - echo " Exhaustive test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCQT64) - - ./run_ssids > ssidscqt64.output 2>&1 - cat ssidscqt64.output - rm ./run_ssids - -ssidscqtf_64: $(SSIDSCQTF64) - echo "" - echo " Exhaustive test of Fortran function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCQTF64) - - ./run_ssids > ssidscqtf64.output 2>&1 - cat ssidscqtf64.output - rm ./run_ssids - -# run debugging C example tests - -ssidscst_valgrind: $(SSIDSCST) - echo "" - echo " Exhaustive valgrind test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCST) - - valgrind $(VALGRIND) ./run_ssids > \ - ssidscst_valgrind.output 2>&1 - cat ssidscst_valgrind.output - rm ./run_ssids - -ssidscstf_valgrind: $(SSIDSCSTF) - echo "" - echo " Exhaustive valgrind test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCSTF) - - valgrind $(VALGRIND) ./run_ssids > \ - ssidscstf_valgrind.output 2>&1 - cat ssidscstf_valgrind.output - rm ./run_ssids - -ssidscst_gdb: $(SSIDSCST) - echo "" - echo " Exhaustive gdb test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCST) - - gdb $(GDB) ./run_ssids - rm ./run_ssids - -ssidscdt_valgrind: $(SSIDSCDT) - echo "" - echo " Exhaustive valgrind test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCDT) - - ./run_ssids > ssidsdt.output 2>&1 - - valgrind $(VALGRIND) ./run_ssids > \ - ssidsdt_valgrind.output 2>&1 - cat ssidsdt_valgrind.output - rm ./run_ssids - -ssidscdt_gdb: $(SSIDSCDT) - echo "" - echo " Exhaustive gdb test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCDT) - $(RMOOC) - - gdb $(GDB) ./run_ssids - rm ./run_ssids - -ssidscqt_valgrind: $(SSIDSCQT) - echo "" - echo " Exhaustive valgrind test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCQT) - - valgrind $(VALGRIND) ./run_ssids > \ - ssidscqt_valgrind.output 2>&1 - cat ssidscqt_valgrind.output - rm ./run_ssids - -ssidscqt_gdb: $(SSIDSCQT) - echo "" - echo " Exhaustive gdb test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCQT) - - gdb $(GDB) ./run_ssids - rm ./run_ssids - -ssidscst_64_valgrind: $(SSIDSCST64) - echo "" - echo " Exhaustive valgrind test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCST64) - - valgrind $(VALGRIND) ./run_ssids > \ - ssidscst64_valgrind.output 2>&1 - cat ssidscst64_valgrind.output - rm ./run_ssids - -ssidscstf_64_valgrind: $(SSIDSCSTF64) - echo "" - echo " Exhaustive valgrind test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCSTF64) - - valgrind $(VALGRIND) ./run_ssids > \ - ssidscstf64_valgrind.output 2>&1 - cat ssidscstf64_valgrind.output - rm ./run_ssids - -ssidscst_64_gdb: $(SSIDSCST64) - echo "" - echo " Exhaustive gdb test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCST64) - - gdb $(GDB) ./run_ssids - rm ./run_ssids - -ssidscdt_64_gdb: $(SSIDSCDT64) - echo "" - echo " Exhaustive gdb test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCDT64) - - gdb $(GDB) ./run_ssids - rm ./run_ssids - -ssidscqt_64_gdb: $(SSIDSCQT64) - echo "" - echo " Exhaustive gdb test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCQT64) - - gdb $(GDB) ./run_ssids - rm ./run_ssids - -ssidscqtf_64_valgrind: $(SSIDSCQTF64) - echo "" - echo " Exhaustive valgrind test of C function interface to ssids" - $(FORTRAN) $(RUNFFLAGSOMP) $(SPECIAL) \ - $(NOFMAIN) -o run_ssids $(RSSIDSCQTF64) - - valgrind $(VALGRIND) ./run_ssids > \ - ssidscqtf64_valgrind.output 2>&1 - cat ssidscqtf64_valgrind.output - rm ./run_ssids - -# basic packages - -basics: - ( cd ../general ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ - basic_silent PRECIS=$(PRECIS) PWD=$(PWD)/../general ) -hw: - ( cd ../hw ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ - hw_silent PRECIS=$(PRECIS) PWD=$(PWD)/../hw ) -mo: - ( cd ../mo ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ - mo_silent PRECIS=$(PRECIS) PWD=$(PWD)/../mo ) -ms: - ( cd ../ms ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ - ms_silent PRECIS=$(PRECIS) PWD=$(PWD)/../ms ) -mu: - ( cd ../mu ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ - mu_silent PRECIS=$(PRECIS) PWD=$(PWD)/../mu ) -rb: - ( cd ../rb ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ - rb_silent PRECIS=$(PRECIS) PWD=$(PWD)/../rb ) -nodend_c: - ( cd ../nodend ; $(MAKE) -f $(GALAHAD)/makefiles/$(VERSION) \ - nodend_ciface_silent PRECIS=$(PRECIS) PWD=$(PWD)/../nodend ) - -# individual compilations - -omp.o: $(RLG)(omp.o) - -$(RLG)(omp.o): ../ssids/omp.cxx $(GALINCLUDE)/ssids_omp.hxx - @printf ' %-9s %-15s\t\t' "Compiling" "omp " - $(CP) ../ssids/omp.cxx $(OBJ)/ - cd $(OBJ) ; $(CXX) -I. -o omp.o $(CXXFLAGSOMP) \ - omp.cxx \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CXX) -I. -o omp.o $(CXXFLAGSNOMP) omp.cxx ) - cd $(OBJ) ; $(RARR) omp.o ; $(RM) omp.cxx omp.o - @printf '[ OK ]\n' - -SymbolicSubtree.o: $(RLG)(SymbolicSubtree.o) - -$(RLG)(SymbolicSubtree.o): ../ssids/SymbolicSubtree.cxx \ - $(GALINCLUDE)/ssids_cpu_SymbolicSubtree.hxx - @printf ' %-9s %-15s\t\t' "Compiling" "SymbolicSubtree " - $(CP) ../ssids/SymbolicSubtree.cxx $(OBJ)/ - cd $(OBJ) ; $(CXX) -I. -o SymbolicSubtree.o $(CXXFLAGSOMP) \ - SymbolicSubtree.cxx \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CXX) -I. -o SymbolicSubtree.o $(CXXFLAGSNOMP) \ - SymbolicSubtree.cxx ) - cd $(OBJ) ; $(RARR) SymbolicSubtree.o ; \ - $(RM) SymbolicSubtree.cxx SymbolicSubtree.o - @printf '[ OK ]\n' - -NumericSubtree.o: $(RLG)(NumericSubtree_$(PRECIS).o) - -$(RLG)(NumericSubtree_$(PRECIS).o): ../ssids/NumericSubtree.cxx \ - $(GALINCLUDE)/ssids_cpu_NumericSubtree.hxx - @printf ' %-9s %-15s\t\t' "Compiling" "NumericSubtree " - $(CP) ../ssids/NumericSubtree.cxx $(OBJ)/ - cd $(OBJ) ; $(CXX) -I. -o NumericSubtree_$(PRECIS).o $(CXXFLAGSOMP) \ - NumericSubtree.cxx \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CXX) -I. -o NumericSubtree_$(PRECIS).o $(CXXFLAGSNOMP) \ - NumericSubtree.cxx ) - cd $(OBJ) ; $(RARR) NumericSubtree_$(PRECIS).o ; \ - $(RM) NumericSubtree.cxx NumericSubtree_$(PRECIS).o - @printf '[ OK ]\n' - -cholesky.o: $(RLG)(cholesky_$(PRECIS).o) - -$(RLG)(cholesky_$(PRECIS).o): ../ssids/cholesky.cxx \ - $(GALINCLUDE)/ssids_cpu_kernels_cholesky.hxx - @printf ' %-9s %-15s\t\t' "Compiling" "cholesky " - $(CP) ../ssids/cholesky.cxx $(OBJ)/ - cd $(OBJ) ; $(CXX) -I. -o cholesky_$(PRECIS).o $(CXXFLAGSOMP) \ - cholesky.cxx \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CXX) -I. -o cholesky_$(PRECIS).o $(CXXFLAGSNOMP) \ - cholesky.cxx ) - cd $(OBJ) ; $(RARR) cholesky_$(PRECIS).o ; \ - $(RM) cholesky.cxx cholesky_$(PRECIS).o - @printf '[ OK ]\n' - -ldlt_app.o: $(RLG)(ldlt_app_$(PRECIS).o) - -$(RLG)(ldlt_app_$(PRECIS).o): ../ssids/ldlt_app.cxx \ - $(GALINCLUDE)/ssids_cpu_kernels_block_ldlt.hxx - @printf ' %-9s %-15s\t\t' "Compiling" "ldlt_app " - $(CP) ../ssids/ldlt_app.cxx $(OBJ)/ - cd $(OBJ) ; $(CXX) -I. -o ldlt_app_$(PRECIS).o $(CXXFLAGSOMP) \ - ldlt_app.cxx \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CXX) -I. -o ldlt_app_$(PRECIS).o $(CXXFLAGSNOMP) \ - ldlt_app.cxx ) - cd $(OBJ) ; $(RARR) ldlt_app_$(PRECIS).o ; \ - $(RM) ldlt_app.cxx ldlt_app_$(PRECIS).o - @printf '[ OK ]\n' - -ldlt_nopiv.o: $(RLG)(ldlt_nopiv_$(PRECIS).o) - -$(RLG)(ldlt_nopiv_$(PRECIS).o): ../ssids/ldlt_nopiv.cxx \ - $(GALINCLUDE)/ssids_cpu_kernels_ldlt_nopiv.hxx - @printf ' %-9s %-15s\t\t' "Compiling" "ldlt_nopiv " - $(CP) ../ssids/ldlt_nopiv.cxx $(OBJ)/ - cd $(OBJ) ; $(CXX) -I. -o ldlt_nopiv_$(PRECIS).o $(CXXFLAGSOMP) \ - ldlt_nopiv.cxx \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CXX) -I. -o ldlt_nopiv_$(PRECIS).o $(CXXFLAGSNOMP) \ - ldlt_nopiv.cxx ) - cd $(OBJ) ; $(RARR) ldlt_nopiv_$(PRECIS).o ; \ - $(RM) ldlt_nopiv.cxx ldlt_nopiv_$(PRECIS).o - @printf '[ OK ]\n' - -ldlt_tpp.o: $(RLG)(ldlt_tpp_$(PRECIS).o) - -$(RLG)(ldlt_tpp_$(PRECIS).o): ../ssids/ldlt_tpp.cxx \ - $(GALINCLUDE)/ssids_cpu_kernels_ldlt_tpp.hxx - @printf ' %-9s %-15s\t\t' "Compiling" "ldlt_tpp " - $(CP) ../ssids/ldlt_tpp.cxx $(OBJ)/ - cd $(OBJ) ; $(CXX) -I. -o ldlt_tpp_$(PRECIS).o $(CXXFLAGSOMP) \ - ldlt_tpp.cxx \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CXX) -I. -o ldlt_tpp_$(PRECIS).o $(CXXFLAGSNOMP) \ - ldlt_tpp.cxx ) - cd $(OBJ) ; $(RARR) ldlt_tpp_$(PRECIS).o ; \ - $(RM) ldlt_tpp.cxx ldlt_tpp_$(PRECIS).o - @printf '[ OK ]\n' - -wrappers.o: $(RLG)(wrappers_$(PRECIS).o) - -$(RLG)(wrappers_$(PRECIS).o): ../ssids/wrappers.cxx \ - $(GALINCLUDE)/ssids_cpu_kernels_wrappers.hxx - @printf ' %-9s %-15s\t\t' "Compiling" "wrappers " - $(CP) ../ssids/wrappers.cxx $(OBJ)/wrappers.cxx - cd $(OBJ) ; $(CXX) -I. -o wrappers_$(PRECIS).o $(CXXFLAGSOMP) \ - wrappers.cxx \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CXX) -I. -o wrappers_$(PRECIS).o $(CXXFLAGSNOMP) \ - wrappers.cxx ) - cd $(OBJ) ; $(RARR) wrappers_$(PRECIS).o ; \ - $(RM) wrappers.cxx wrappers_$(PRECIS).o - @printf '[ OK ]\n' - -ThreadStats.o: $(RLG)(ThreadStats.o) - -$(RLG)(ThreadStats.o): ../ssids/ThreadStats.cxx \ - $(GALINCLUDE)/ssids_cpu_ThreadStats.hxx - @printf ' %-9s %-15s\t\t' "Compiling" "ThreadStats " - $(CP) ../ssids/ThreadStats.cxx $(OBJ)/ - cd $(OBJ) ; $(CXX) -I. -o ThreadStats.o $(CXXFLAGSOMP) \ - ThreadStats.cxx \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CXX) -I. -o ThreadStats.o $(CXXFLAGSNOMP) \ - ThreadStats.cxx ) - cd $(OBJ) ; $(RARR) ThreadStats.o ; \ - $(RM) ThreadStats.cxx ThreadStats.o - @printf '[ OK ]\n' - -types.o: $(RLG)(types_$(PRECIS).o) - -$(RLG)(types_$(PRECIS).o): ../ssids/types.F90 - @printf ' %-9s %-15s\t\t' "Compiling" "types " - $(CP) ../ssids/types.F90 $(OBJ)/types.F90 - cd $(OBJ) ; $(FORTRAN) -o types_$(PRECIS).o \ - $(FFLAGSOMP) types.F90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o types_$(PRECIS).o \ - $(FFLAGSNOMP) types.F90 ) - cd $(OBJ) ; $(RARR) types_$(PRECIS).o ; \ - $(RM) types.F90 types_$(PRECIS).o - $(RRMARFILE) cpu_subtree_$(PRECIS).o - $(MVMODS) - @printf '[ OK ]\n' - -subtree.o: $(RLG)(subtree_$(PRECIS).o) - -$(RLG)(subtree_$(PRECIS).o): ../ssids/subtree.F90 - @printf ' %-9s %-15s\t\t' "Compiling" "subtree " - $(CP) ../ssids/subtree.F90 $(OBJ)/subtree.F90 - cd $(OBJ) ; $(FORTRAN) -o subtree_$(PRECIS).o \ - $(FFLAGSOMP) subtree.F90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o subtree_$(PRECIS).o \ - $(FFLAGSNOMP) subtree.F90 ) - cd $(OBJ) ; $(RARR) subtree_$(PRECIS).o ; \ - $(RM) subtree.F90 subtree_$(PRECIS).o - $(RRMARFILE) cpu_subtree_$(PRECIS).o - $(RRMARFILE) akeep_$(PRECIS).o - $(MVMODS) - @printf '[ OK ]\n' - -akeep.o: $(RLG)(akeep_$(PRECIS).o) - -$(RLG)(akeep_$(PRECIS).o): ../ssids/akeep.F90 - @printf ' %-9s %-15s\t\t' "Compiling" "akeep " - $(CP) ../ssids/akeep.F90 $(OBJ)/akeep.F90 - cd $(OBJ) ; $(FORTRAN) -o akeep_$(PRECIS).o $(FFLAGSOMP) akeep.F90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o akeep_$(PRECIS).o $(FFLAGSNOMP) akeep.F90 ) - cd $(OBJ) ; $(RARR) akeep_$(PRECIS).o ; \ - $(RM) akeep.F90 akeep_$(PRECIS).o - $(RRMARFILE) ssids_$(PRECIS).o - $(MVMODS) - @printf '[ OK ]\n' - -cpu_iface.o: $(RLG)(cpu_iface_$(PRECIS).o) - -$(RLG)(cpu_iface_$(PRECIS).o): ../ssids/cpu_iface.F90 - @printf ' %-9s %-15s\t\t' "Compiling" "cpu_iface " - $(CP) ../ssids/cpu_iface.F90 $(OBJ)/cpu_iface.F90 - cd $(OBJ) ; $(FORTRAN) -o cpu_iface_$(PRECIS).o \ - $(FFLAGSOMP) cpu_iface.F90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cpu_iface_$(PRECIS).o \ - $(FFLAGSNOMP) cpu_iface.F90 ) - cd $(OBJ) ; $(RARR) cpu_iface_$(PRECIS).o ; \ - $(RM) cpu_iface.F90 cpu_iface_$(PRECIS).o - $(RRMARFILE) cpu_subtree_$(PRECIS).o - $(MVMODS) - @printf '[ OK ]\n' - -cpu_subtree.o: $(RLG)(cpu_subtree_$(PRECIS).o) - -$(RLG)(cpu_subtree_$(PRECIS).o): ../ssids/cpu_subtree.F90 - @printf ' %-9s %-15s\t\t' "Compiling" "cpu_subtree " - $(CP) ../ssids/cpu_subtree.F90 $(OBJ)/cpu_subtree.F90 - cd $(OBJ) ; $(FORTRAN) -o cpu_subtree_$(PRECIS).o \ - $(FFLAGSOMP) cpu_subtree.F90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o cpu_subtree_$(PRECIS).o \ - $(FFLAGSNOMP) cpu_subtree.F90 ) - cd $(OBJ) ; $(RARR) cpu_subtree_$(PRECIS).o ; \ - $(RM) cpu_subtree.F90 cpu_subtree_$(PRECIS).o - $(RRMARFILE) ssids_$(PRECIS).o - $(MVMODS) - @printf '[ OK ]\n' - -contrib_iface.o: $(RLG)(contrib_iface_$(PRECIS).o) - -$(RLG)(contrib_iface_$(PRECIS).o): ../ssids/contrib_iface.F90 - @printf ' %-9s %-15s\t\t' "Compiling" "contrib_iface " - $(CP) ../ssids/contrib_iface.F90 $(OBJ)/contrib_iface.F90 - cd $(OBJ) ; $(FORTRAN) -o contrib_iface_$(PRECIS).o $(FFLAGSOMP) \ - contrib_iface.F90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o contrib_iface_$(PRECIS).o $(FFLAGSNOMP) \ - contrib_iface.F90 ) - cd $(OBJ) ; $(RARR) contrib_iface_$(PRECIS).o ; \ - $(RM) contrib_iface.F90 contrib_iface_$(PRECIS).o -# $(MVMODS) - @printf '[ OK ]\n' - -ssids.o: $(RLG)(ssids_$(PRECIS).o) - -$(RLG)(ssids_$(PRECIS).o): ../ssids/ssids.F90 - @printf ' %-9s %-15s\t\t' "Compiling" "ssids " - $(CP) ../ssids/ssids.F90 $(OBJ)/ssids.F90 - cd $(OBJ) ; $(FORTRAN) -o ssids_$(PRECIS).o $(FFLAGSOMP) ssids.F90 \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o ssids_$(PRECIS).o $(FFLAGSNOMP) ssids.F90 ) - cd $(OBJ) ; $(RARR) ssids_$(PRECIS).o ; \ - $(RM) ssids.F90 ssids_$(PRECIS).o - $(RMARFILE) sls_$(PRECIS).o - $(MVMODS) - @printf '[ OK ]\n' - -# C interface - -ssids_ciface.o: $(CLG)(ssids_ciface_$(PRECIS).o) - -$(CLG)(ssids_ciface_$(PRECIS).o): ../ssids/C/ssids_ciface.F90 - @printf ' %-9s %-15s\t\t' "Compiling" "ssids_ciface" - $(CP) ../ssids/C/ssids_ciface.F90 $(OBJ)/ssids_ciface.F90 - cd $(OBJ) ; $(FORTRAN) -o ssids_ciface_$(PRECIS).o $(FFLAGSOMP) \ - ssids_ciface.F90 - cd $(OBJ) ; $(CARR) ssids_ciface_$(PRECIS).o ; \ - $(RM) ssids_ciface.F90 ssids_ciface_$(PRECIS).o - $(CRMARFILE) sls_ciface_$(PRECIS).o - $(MVMODS) - @printf '[ OK ]\n' - -# test programs - -ssidss.o: $(OBJ)/ssidss_$(PRECIS).o - -$(OBJ)/ssidss_$(PRECIS).o: ../ssids/ssidss.f90 - @printf ' %-9s %-15s\t\t' "Compiling" "ssidss " - $(SED) -f $(SEDS) ../ssids/ssidss.f90 > $(OBJ)/ssidss.f90 - cd $(OBJ) ; $(FORTRAN) -o ssidss_$(PRECIS).o $(FFLAGSOMP) ssidss.f90 - rm $(OBJ)/*.f90 - @printf '[ OK ]\n' - -ssidst.o: $(OBJ)/ssidst_$(PRECIS).o - -$(OBJ)/ssidst_$(PRECIS).o: ../ssids/ssidst.F90 - @printf ' %-9s %-15s\t\t' "Compiling" "ssidst " - $(CP) ../ssids/ssidst.F90 $(OBJ)/ssidst.F90 - cd $(OBJ) ; $(FORTRAN) -o ssidst_$(PRECIS).o $(FFLAGSS) ssidst.F90 - rm $(OBJ)/*.F90 - @printf '[ OK ]\n' - -ssidst2.o: $(OBJ)/ssidst2_$(PRECIS).o - -$(OBJ)/ssidst2_$(PRECIS).o: ../ssids/ssidst2.F90 - @printf ' %-9s %-15s\t\t' "Compiling" "ssidst2 " - $(CP) ../ssids/ssidst2.F90 $(OBJ)/ssidst2.F90 - cd $(OBJ) ; $(FORTRAN) -o ssidst2_$(PRECIS).o $(FFLAGSS) ssidst2.F90 - rm $(OBJ)/*.F90 - @printf '[ OK ]\n' - -# test programs for C programs - -ssidsct.o: $(OBJ)/ssidsct_$(PRECIS).o - -$(OBJ)/ssidsct_$(PRECIS).o: ../ssids/C/ssidst.c - @printf ' %-9s %-15s\t\t' "Compiling" "ssidsct " - $(CP) ../ssids/C/ssidst.c $(OBJ)/ssidsct.c - cd $(OBJ) ; $(CC) -o ssidsct_$(PRECIS).o $(CFLAGS) \ - ssidsct.c -I $(GALAHAD)/include -I $(OBJ) - rm $(OBJ)/*.c - @printf '[ OK ]\n' - -ssidsctf.o: $(OBJ)/ssidsctf_$(PRECIS).o - -$(OBJ)/ssidsctf_$(PRECIS).o: ../ssids/C/ssidstf.c - @printf ' %-9s %-15s\t\t' "Compiling" "ssidsctf " - $(CP) ../ssids/C/ssidstf.c $(OBJ)/ssidsctf.c - cd $(OBJ) ; $(CC) -o ssidsctf_$(PRECIS).o $(CFLAGS) \ - ssidsctf.c -I $(GALAHAD)/include -I $(OBJ) - rm $(OBJ)/*.c - @printf '[ OK ]\n' - -# book keeping - -clean: - @printf ' %-9s %-15s\t\t' "Cleaning $(PRECIS) precision spral" - $(RM) $(LGS) $(LGD) $(OBJ)/ssids*.o $(OBJ)/libgalahad_spral.a \ - $(MOD)/spral* - @printf '[ OK ]\n' - -cleanall: - @printf ' %-14s\t\t' \ - "Removing all $(PRECIS) precision object and module files" - $(RM) -r $(OBJ)/* $(MOD)/* - @printf '[ OK ]\n' - -rmssids: - @printf ' %-9s %-15s\t\t' "Removing" "ssids from archive " - $(RRMARFILE) ssids_$(PRECIS).o - @printf '[ OK ]\n' diff --git a/src/ssids/meson.build b/src/ssids/meson.build deleted file mode 100644 index 246e7009fb..0000000000 --- a/src/ssids/meson.build +++ /dev/null @@ -1,19 +0,0 @@ -if build_ssids - libgalahad_cpp_src += files('omp.cxx', 'cholesky.cxx', - 'ldlt_app.cxx', 'ldlt_nopiv.cxx', - 'ldlt_tpp.cxx', 'NumericSubtree.cxx', - 'SymbolicSubtree.cxx', 'ThreadStats.cxx', - 'wrappers.cxx') - - libgalahad_src += files('ssids.F90', 'contrib_iface.F90', 'cpu_iface.F90', - 'cpu_subtree.F90', 'types.F90', 'subtree.F90') - - libgalahad_c_src += files('C/ssids_ciface.F90') - - galahad_tests += [['ssids', 'ssidst', files('ssidst.F90')]] - - galahad_c_tests += [['ssids', 'ssidst_c', files('C/ssidst.c')], - ['ssids', 'ssidstf_c', files('C/ssidstf.c')]] - - galahad_examples += [['ssidss', files('ssidss.f90')]] -endif diff --git a/src/ssids/omp.cxx b/src/ssids/omp.cxx deleted file mode 100644 index afe0573ef0..0000000000 --- a/src/ssids/omp.cxx +++ /dev/null @@ -1,28 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * - * \brief - * Additional support functions and wrappers for OpenMP. - */ -#include "ssids_omp.hxx" - -/* This file wraps the C interface for OpenMP in C++ for style/safety */ -namespace galahad { namespace omp { - -int get_global_thread_num() { -#ifdef _OPENMP - int nbelow = 1; - int thread_num = 0; - for(int level=omp_get_level(); level>0; --level) { - thread_num += nbelow * omp_get_ancestor_thread_num(level); - nbelow *= omp_get_team_size(level); - } - return thread_num; -#else - return 0; -#endif /* _OPENMP */ -} - -}} /* namepsace galahad::omp */ diff --git a/src/ssids/wrappers.cxx b/src/ssids/wrappers.cxx deleted file mode 100644 index 346619721c..0000000000 --- a/src/ssids/wrappers.cxx +++ /dev/null @@ -1,841 +0,0 @@ -/** \file - * \copyright 2016 The Science and Technology Facilities Council (STFC) - * \licence BSD licence, see LICENCE file for details - * \author Jonathan Hogg - * \version Nick Gould, fork for GALAHAD 5.3 - 2025-08-17 AT 09:00 GMT - */ -#include "ssids_cpu_kernels_wrappers.hxx" - -#include - -#ifdef REAL_32 - -/* ================ SINGLE PRECISION WITH 64 BIT INTEGERS =================== */ - -#ifdef INTEGER_64 - -extern "C" { - void spral_c_sgemm_64(char* transa, char* transb, - int64_t* m, int64_t* n, int64_t* k, - float* alpha, const float* a, int64_t* lda, - const float* b, int64_t* ldb, float *beta, - float* c, int64_t* ldc); - void spral_c_spotrf_64(char *uplo, int64_t *n, float *a, - int64_t *lda, int64_t *info); - void spral_c_ssytrf_64(char *uplo, int64_t *n, float *a, - int64_t *lda, int64_t *ipiv, float *work, - int64_t *lwork, int64_t *info); - void spral_c_strsm_64(char *side, char *uplo, char *transa, - char *diag, int64_t *m, int64_t *n, - const float *alpha, const float *a, - int64_t *lda, float *b, int64_t *ldb); - void spral_c_ssyrk_64(char *uplo, char *trans, - int64_t *n, int64_t *k, float *alpha, - const float *a, int64_t *lda, float *beta, - float *c, int64_t *ldc); - void spral_c_strsv_64(char *uplo, char *trans, char *diag, - int64_t *n, const float *a, int64_t *lda, - float *x, int64_t *incx); - void spral_c_sgemv_64(char *trans, int64_t *m, int64_t *n, - const float* alpha, const float* a, - int64_t *lda, const float* x, int64_t* incx, - const float* beta, float* y, int64_t* incy); -} - -namespace galahad { namespace ssids { namespace cpu { - -/* _GEMM */ -template <> -void host_gemm_64(enum galahad::ssids::cpu::operation transa, - enum galahad::ssids::cpu::operation transb, - int64_t m, int64_t n, int64_t k, float alpha, - const float* a, int64_t lda, const float* b, - int64_t ldb, float beta, float* c, int64_t ldc) { - char ftransa = (transa==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char ftransb = (transb==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_sgemm_64(&ftransa, &ftransb, &m, &n, &k, &alpha, a, &lda, - b, &ldb, &beta, c, &ldc); -} - -/* _GEMV */ -template <> -void gemv_64(enum galahad::ssids::cpu::operation trans, - int64_t m, int64_t n, float alpha, const float* a, - int64_t lda, const float* x, int64_t incx, - float beta, float* y, int64_t incy) { - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_sgemv_64(&ftrans, &m, &n, &alpha, a, &lda, x, &incx, - &beta, y, &incy); -} - -/* _POTRF */ -template<> -int64_t lapack_potrf_64(enum galahad::ssids::cpu::fillmode uplo, - int64_t n, float* a, int64_t lda) { - char fuplo; - switch(uplo) { - case galahad::ssids::cpu::FILL_MODE_LWR: fuplo = 'L'; break; - case galahad::ssids::cpu::FILL_MODE_UPR: fuplo = 'U'; break; - default: throw std::runtime_error("Unknown fill mode"); - } - int64_t info; - spral_c_spotrf_64(&fuplo, &n, a, &lda, &info); - return info; -} - -/* _SYTRF - Bunch-Kaufman factorization */ -template<> -int64_t lapack_sytrf_64(enum galahad::ssids::cpu::fillmode uplo, - int64_t n, float* a, int64_t lda, - int64_t *ipiv, float* work, int64_t lwork) { - char fuplo; - switch(uplo) { - case galahad::ssids::cpu::FILL_MODE_LWR: fuplo = 'L'; break; - case galahad::ssids::cpu::FILL_MODE_UPR: fuplo = 'U'; break; - default: throw std::runtime_error("Unknown fill mode"); - } - int64_t info; - spral_c_ssytrf_64(&fuplo, &n, a, &lda, ipiv, work, &lwork, &info); - return info; -} - -/* _SYRK */ -template <> -void host_syrk_64(enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation trans, - int64_t n, int64_t k, float alpha, const float* a, - int64_t lda, float beta, float* c, int64_t ldc) { - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_ssyrk_64(&fuplo, &ftrans, &n, &k, &alpha, a, &lda, &beta, c, &ldc); -} - -/* _TRSV */ -template <> -void host_trsv_64(enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation trans, - enum galahad::ssids::cpu::diagonal diag, - int64_t n, const float* a, int64_t lda, - float* x, int64_t incx) { - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char fdiag = (diag==galahad::ssids::cpu::DIAG_UNIT) ? 'U' : 'N'; - spral_c_strsv_64(&fuplo, &ftrans, &fdiag, &n, a, &lda, x, &incx); -} - -/* _TRSM */ -template <> -void host_trsm_64(enum galahad::ssids::cpu::side side, - enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation transa, - enum galahad::ssids::cpu::diagonal diag, - int64_t m, int64_t n, float alpha, const float* a, - int64_t lda, float* b, int64_t ldb) { - char fside = (side==galahad::ssids::cpu::SIDE_LEFT) ? 'L' : 'R'; - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftransa = (transa==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char fdiag = (diag==galahad::ssids::cpu::DIAG_UNIT) ? 'U' : 'N'; - spral_c_strsm_64(&fside, &fuplo, &ftransa, &fdiag, &m, &n, &alpha, - a, &lda, b, &ldb); -} - -}}} /* namespaces galahad::ssids::cpu */ - -/* =========================== SINGLE PRECISION ============================= */ - -#else - -extern "C" { - void spral_c_sgemm(char* transa, char* transb, - int* m, int* n, int* k, - float* alpha, const float* a, int* lda, - const float* b, int* ldb, float *beta, - float* c, int* ldc); - void spral_c_spotrf(char *uplo, int *n, float *a, - int *lda, int *info); - void spral_c_ssytrf(char *uplo, int *n, float *a, - int *lda, int *ipiv, float *work, - int *lwork, int *info); - void spral_c_strsm(char *side, char *uplo, char *transa, - char *diag, int *m, int *n, - const float *alpha, const float *a, - int *lda, float *b, int *ldb); - void spral_c_ssyrk(char *uplo, char *trans, - int *n, int *k, float *alpha, - const float *a, int *lda, float *beta, - float *c, int *ldc); - void spral_c_strsv(char *uplo, char *trans, char *diag, - int *n, const float *a, int *lda, - float *x, int *incx); - void spral_c_sgemv(char *trans, int *m, int *n, - const float* alpha, const float* a, - int *lda, const float* x, int* incx, - const float* beta, float* y, int* incy); -} - -namespace galahad { namespace ssids { namespace cpu { - -/* _GEMM */ -template <> -void host_gemm(enum galahad::ssids::cpu::operation transa, - enum galahad::ssids::cpu::operation transb, - int m, int n, int k, float alpha, - const float* a, int lda, const float* b, - int ldb, float beta, float* c, int ldc) { - char ftransa = (transa==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char ftransb = (transb==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_sgemm(&ftransa, &ftransb, &m, &n, &k, &alpha, a, &lda, - b, &ldb, &beta, c, &ldc); -} - -/* _GEMV */ -template <> -void gemv(enum galahad::ssids::cpu::operation trans, - int m, int n, float alpha, const float* a, - int lda, const float* x, int incx, - float beta, float* y, int incy) { - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_sgemv(&ftrans, &m, &n, &alpha, a, &lda, x, &incx, - &beta, y, &incy); -} - -/* _POTRF */ -template<> -int lapack_potrf(enum galahad::ssids::cpu::fillmode uplo, - int n, float* a, int lda) { - char fuplo; - switch(uplo) { - case galahad::ssids::cpu::FILL_MODE_LWR: fuplo = 'L'; break; - case galahad::ssids::cpu::FILL_MODE_UPR: fuplo = 'U'; break; - default: throw std::runtime_error("Unknown fill mode"); - } - int info; - spral_c_spotrf(&fuplo, &n, a, &lda, &info); - return info; -} - -/* _SYTRF - Bunch-Kaufman factorization */ -template<> -int lapack_sytrf(enum galahad::ssids::cpu::fillmode uplo, - int n, float* a, int lda, - int *ipiv, float* work, int lwork) { - char fuplo; - switch(uplo) { - case galahad::ssids::cpu::FILL_MODE_LWR: fuplo = 'L'; break; - case galahad::ssids::cpu::FILL_MODE_UPR: fuplo = 'U'; break; - default: throw std::runtime_error("Unknown fill mode"); - } - int info; - spral_c_ssytrf(&fuplo, &n, a, &lda, ipiv, work, &lwork, &info); - return info; -} - -/* _SYRK */ -template <> -void host_syrk(enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation trans, - int n, int k, float alpha, const float* a, - int lda, float beta, float* c, int ldc) { - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_ssyrk(&fuplo, &ftrans, &n, &k, &alpha, a, &lda, &beta, c, &ldc); -} - -/* _TRSV */ -template <> -void host_trsv(enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation trans, - enum galahad::ssids::cpu::diagonal diag, - int n, const float* a, int lda, - float* x, int incx) { - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char fdiag = (diag==galahad::ssids::cpu::DIAG_UNIT) ? 'U' : 'N'; - spral_c_strsv(&fuplo, &ftrans, &fdiag, &n, a, &lda, x, &incx); -} - -/* _TRSM */ -template <> -void host_trsm(enum galahad::ssids::cpu::side side, - enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation transa, - enum galahad::ssids::cpu::diagonal diag, - int m, int n, float alpha, const float* a, - int lda, float* b, int ldb) { - char fside = (side==galahad::ssids::cpu::SIDE_LEFT) ? 'L' : 'R'; - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftransa = (transa==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char fdiag = (diag==galahad::ssids::cpu::DIAG_UNIT) ? 'U' : 'N'; - spral_c_strsm(&fside, &fuplo, &ftransa, &fdiag, &m, &n, &alpha, - a, &lda, b, &ldb); -} - -}}} /* namespaces galahad::ssids::cpu */ - -#endif - -#elif REAL_128 - -/* ============== QUADRUPLE PRECISION WITH 64 BIT INTEGERS ================= */ - -#ifdef INTEGER_64 - -extern "C" { - void spral_c_qgemm_64(char* transa, char* transb, - int64_t* m, int64_t* n, int64_t* k, - __float128* alpha, const __float128* a, int64_t* lda, - const __float128* b, int64_t* ldb, __float128 *beta, - __float128* c, int64_t* ldc); - void spral_c_qpotrf_64(char *uplo, int64_t *n, __float128 *a, - int64_t *lda, int64_t *info); - void spral_c_qsytrf_64(char *uplo, int64_t *n, __float128 *a, - int64_t *lda, int64_t *ipiv, __float128 *work, - int64_t *lwork, int64_t *info); - void spral_c_qtrsm_64(char *side, char *uplo, char *transa, - char *diag, int64_t *m, int64_t *n, - const __float128 *alpha, const __float128 *a, - int64_t *lda, __float128 *b, int64_t *ldb); - void spral_c_qsyrk_64(char *uplo, char *trans, - int64_t *n, int64_t *k, __float128 *alpha, - const __float128 *a, int64_t *lda, __float128 *beta, - __float128 *c, int64_t *ldc); - void spral_c_qtrsv_64(char *uplo, char *trans, char *diag, - int64_t *n, const __float128 *a, int64_t *lda, - __float128 *x, int64_t *incx); - void spral_c_qgemv_64(char *trans, int64_t *m, int64_t *n, - const __float128* alpha, const __float128* a, - int64_t *lda, const __float128* x, int64_t* incx, - const __float128* beta, __float128* y, int64_t* incy); -} - -namespace galahad { namespace ssids { namespace cpu { - -/* _GEMM */ -template <> -void host_gemm_64<__float128>(enum galahad::ssids::cpu::operation transa, - enum galahad::ssids::cpu::operation transb, - int64_t m, int64_t n, int64_t k, __float128 alpha, - const __float128* a, int64_t lda, const __float128* b, - int64_t ldb, __float128 beta, __float128* c, - int64_t ldc) { - char ftransa = (transa==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char ftransb = (transb==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_qgemm_64(&ftransa, &ftransb, &m, &n, &k, &alpha, a, &lda, - b, &ldb, &beta, c, &ldc); -} - -/* _GEMV */ -template <> -void gemv_64<__float128>(enum galahad::ssids::cpu::operation trans, - int64_t m, int64_t n, __float128 alpha, - const __float128* a, - int64_t lda, const __float128* x, int64_t incx, - __float128 beta, __float128* y, int64_t incy) { - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_qgemv_64(&ftrans, &m, &n, &alpha, a, &lda, x, &incx, - &beta, y, &incy); -} - -/* _POTRF */ -template<> -int64_t lapack_potrf_64<__float128>(enum galahad::ssids::cpu::fillmode uplo, - int64_t n, __float128* a, int64_t lda) { - char fuplo; - switch(uplo) { - case galahad::ssids::cpu::FILL_MODE_LWR: fuplo = 'L'; break; - case galahad::ssids::cpu::FILL_MODE_UPR: fuplo = 'U'; break; - default: throw std::runtime_error("Unknown fill mode"); - } - int64_t info; - spral_c_qpotrf_64(&fuplo, &n, a, &lda, &info); - return info; -} - -/* _SYTRF - Bunch-Kaufman factorization */ -template<> -int64_t lapack_sytrf_64<__float128>(enum galahad::ssids::cpu::fillmode uplo, - int64_t n, __float128* a, int64_t lda, - int64_t *ipiv, __float128* work, int64_t lwork) { - char fuplo; - switch(uplo) { - case galahad::ssids::cpu::FILL_MODE_LWR: fuplo = 'L'; break; - case galahad::ssids::cpu::FILL_MODE_UPR: fuplo = 'U'; break; - default: throw std::runtime_error("Unknown fill mode"); - } - int64_t info; - spral_c_qsytrf_64(&fuplo, &n, a, &lda, ipiv, work, &lwork, &info); - return info; -} - -/* _SYRK */ -template <> -void host_syrk_64<__float128>(enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation trans, - int64_t n, int64_t k, __float128 alpha, - const __float128* a, int64_t lda, __float128 beta, - __float128* c, int64_t ldc) { - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_qsyrk_64(&fuplo, &ftrans, &n, &k, &alpha, a, &lda, &beta, c, &ldc); -} - -/* _TRSV */ -template <> -void host_trsv_64<__float128>(enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation trans, - enum galahad::ssids::cpu::diagonal diag, - int64_t n, const __float128* a, int64_t lda, - __float128* x, int64_t incx) { - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char fdiag = (diag==galahad::ssids::cpu::DIAG_UNIT) ? 'U' : 'N'; - spral_c_qtrsv_64(&fuplo, &ftrans, &fdiag, &n, a, &lda, x, &incx); -} - -/* _TRSM */ -template <> -void host_trsm_64<__float128>(enum galahad::ssids::cpu::side side, - enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation transa, - enum galahad::ssids::cpu::diagonal diag, - int64_t m, int64_t n, __float128 alpha, - const __float128* a, int64_t lda, __float128* b, - int64_t ldb) { - char fside = (side==galahad::ssids::cpu::SIDE_LEFT) ? 'L' : 'R'; - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftransa = (transa==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char fdiag = (diag==galahad::ssids::cpu::DIAG_UNIT) ? 'U' : 'N'; - spral_c_qtrsm_64(&fside, &fuplo, &ftransa, &fdiag, &m, &n, &alpha, - a, &lda, b, &ldb); -} - -}}} /* namespaces galahad::ssids::cpu */ - -/* ========================= QUADRUPLE PRECISION =========================== */ - -#else - -extern "C" { - void spral_c_qgemm(char* transa, char* transb, - int* m, int* n, int* k, - __float128* alpha, const __float128* a, int* lda, - const __float128* b, int* ldb, __float128 *beta, - __float128* c, int* ldc); - void spral_c_qpotrf(char *uplo, int *n, __float128 *a, - int *lda, int *info); - void spral_c_qsytrf(char *uplo, int *n, __float128 *a, - int *lda, int *ipiv, __float128 *work, - int *lwork, int *info); - void spral_c_qtrsm(char *side, char *uplo, char *transa, - char *diag, int *m, int *n, - const __float128 *alpha, const __float128 *a, - int *lda, __float128 *b, int *ldb); - void spral_c_qsyrk(char *uplo, char *trans, - int *n, int *k, __float128 *alpha, - const __float128 *a, int *lda, __float128 *beta, - __float128 *c, int *ldc); - void spral_c_qtrsv(char *uplo, char *trans, char *diag, - int *n, const __float128 *a, int *lda, - __float128 *x, int *incx); - void spral_c_qgemv(char *trans, int *m, int *n, - const __float128* alpha, const __float128* a, - int *lda, const __float128* x, int* incx, - const __float128* beta, __float128* y, int* incy); -} - -namespace galahad { namespace ssids { namespace cpu { - -/* _GEMM */ -template <> -void host_gemm<__float128>(enum galahad::ssids::cpu::operation transa, - enum galahad::ssids::cpu::operation transb, - int m, int n, int k, __float128 alpha, - const __float128* a, int lda, const __float128* b, - int ldb, __float128 beta, __float128* c, int ldc) { - char ftransa = (transa==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char ftransb = (transb==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_qgemm(&ftransa, &ftransb, &m, &n, &k, &alpha, a, &lda, - b, &ldb, &beta, c, &ldc); -} - -/* _GEMV */ -template <> -void gemv<__float128>(enum galahad::ssids::cpu::operation trans, - int m, int n, __float128 alpha, const __float128* a, - int lda, const __float128* x, int incx, - __float128 beta, __float128* y, int incy) { - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_qgemv(&ftrans, &m, &n, &alpha, a, &lda, x, &incx, - &beta, y, &incy); -} - -/* _POTRF */ -template<> -int lapack_potrf<__float128>(enum galahad::ssids::cpu::fillmode uplo, - int n, __float128* a, int lda) { - char fuplo; - switch(uplo) { - case galahad::ssids::cpu::FILL_MODE_LWR: fuplo = 'L'; break; - case galahad::ssids::cpu::FILL_MODE_UPR: fuplo = 'U'; break; - default: throw std::runtime_error("Unknown fill mode"); - } - int info; - spral_c_qpotrf(&fuplo, &n, a, &lda, &info); - return info; -} - -/* _SYTRF - Bunch-Kaufman factorization */ -template<> -int lapack_sytrf<__float128>(enum galahad::ssids::cpu::fillmode uplo, - int n, __float128* a, int lda, - int *ipiv, __float128* work, int lwork) { - char fuplo; - switch(uplo) { - case galahad::ssids::cpu::FILL_MODE_LWR: fuplo = 'L'; break; - case galahad::ssids::cpu::FILL_MODE_UPR: fuplo = 'U'; break; - default: throw std::runtime_error("Unknown fill mode"); - } - int info; - spral_c_qsytrf(&fuplo, &n, a, &lda, ipiv, work, &lwork, &info); - return info; -} - -/* _SYRK */ -template <> -void host_syrk<__float128>(enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation trans, - int n, int k, __float128 alpha, const __float128* a, - int lda, __float128 beta, __float128* c, int ldc) { - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_qsyrk(&fuplo, &ftrans, &n, &k, &alpha, a, &lda, &beta, c, &ldc); -} - -/* _TRSV */ -template <> -void host_trsv<__float128>(enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation trans, - enum galahad::ssids::cpu::diagonal diag, - int n, const __float128* a, int lda, - __float128* x, int incx) { - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char fdiag = (diag==galahad::ssids::cpu::DIAG_UNIT) ? 'U' : 'N'; - spral_c_qtrsv(&fuplo, &ftrans, &fdiag, &n, a, &lda, x, &incx); -} - -/* _TRSM */ -template <> -void host_trsm<__float128>(enum galahad::ssids::cpu::side side, - enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation transa, - enum galahad::ssids::cpu::diagonal diag, - int m, int n, __float128 alpha, const __float128* a, - int lda, __float128* b, int ldb) { - char fside = (side==galahad::ssids::cpu::SIDE_LEFT) ? 'L' : 'R'; - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftransa = (transa==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char fdiag = (diag==galahad::ssids::cpu::DIAG_UNIT) ? 'U' : 'N'; - spral_c_qtrsm(&fside, &fuplo, &ftransa, &fdiag, &m, &n, &alpha, - a, &lda, b, &ldb); -} - -}}} /* namespaces galahad::ssids::cpu */ - -#endif - - - - - - - - - - - - - - - - - - - -#else - -/* ================ DOUBLE PRECISION WITH 64 BIT INTEGERS =================== */ - -#ifdef INTEGER_64 - -extern "C" { - void spral_c_dgemm_64(char* transa, char* transb, - int64_t* m, int64_t* n, int64_t* k, - double* alpha, const double* a, int64_t* lda, - const double* b, int64_t* ldb, double *beta, - double* c, int64_t* ldc); - void spral_c_dpotrf_64(char *uplo, int64_t *n, double *a, - int64_t *lda, int64_t *info); - void spral_c_dsytrf_64(char *uplo, int64_t *n, double *a, - int64_t *lda, int64_t *ipiv, double *work, - int64_t *lwork, int64_t *info); - void spral_c_dtrsm_64(char *side, char *uplo, char *transa, - char *diag, int64_t *m, int64_t *n, - const double *alpha, const double *a, - int64_t *lda, double *b, int64_t *ldb); - void spral_c_dsyrk_64(char *uplo, char *trans, - int64_t *n, int64_t *k, double *alpha, - const double *a, int64_t *lda, double *beta, - double *c, int64_t *ldc); - void spral_c_dtrsv_64(char *uplo, char *trans, char *diag, - int64_t *n, const double *a, int64_t *lda, - double *x, int64_t *incx); - void spral_c_dgemv_64(char *trans, int64_t *m, int64_t *n, - const double* alpha, const double* a, - int64_t *lda, const double* x, int64_t* incx, - const double* beta, double* y, int64_t* incy); -} - -namespace galahad { namespace ssids { namespace cpu { - -/* _GEMM */ -template <> -void host_gemm_64(enum galahad::ssids::cpu::operation transa, - enum galahad::ssids::cpu::operation transb, - int64_t m, int64_t n, int64_t k, double alpha, - const double* a, int64_t lda, const double* b, - int64_t ldb, double beta, double* c, int64_t ldc) { - char ftransa = (transa==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char ftransb = (transb==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_dgemm_64(&ftransa, &ftransb, &m, &n, &k, &alpha, a, &lda, - b, &ldb, &beta, c, &ldc); -} - -/* _GEMV */ -template <> -void gemv_64(enum galahad::ssids::cpu::operation trans, - int64_t m, int64_t n, double alpha, const double* a, - int64_t lda, const double* x, int64_t incx, - double beta, double* y, int64_t incy) { - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_dgemv_64(&ftrans, &m, &n, &alpha, a, &lda, x, &incx, - &beta, y, &incy); -} - -/* _POTRF */ -template<> -int64_t lapack_potrf_64(enum galahad::ssids::cpu::fillmode uplo, - int64_t n, double* a, int64_t lda) { - char fuplo; - switch(uplo) { - case galahad::ssids::cpu::FILL_MODE_LWR: fuplo = 'L'; break; - case galahad::ssids::cpu::FILL_MODE_UPR: fuplo = 'U'; break; - default: throw std::runtime_error("Unknown fill mode"); - } - int64_t info; - spral_c_dpotrf_64(&fuplo, &n, a, &lda, &info); - return info; -} - -/* _SYTRF - Bunch-Kaufman factorization */ -template<> -int64_t lapack_sytrf_64(enum galahad::ssids::cpu::fillmode uplo, - int64_t n, double* a, - int64_t lda, int64_t *ipiv, - double* work, int64_t lwork) { - char fuplo; - switch(uplo) { - case galahad::ssids::cpu::FILL_MODE_LWR: fuplo = 'L'; break; - case galahad::ssids::cpu::FILL_MODE_UPR: fuplo = 'U'; break; - default: throw std::runtime_error("Unknown fill mode"); - } - int64_t info; - spral_c_dsytrf_64(&fuplo, &n, a, &lda, ipiv, work, &lwork, &info); - return info; -} - -/* _SYRK */ -template <> -void host_syrk_64(enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation trans, - int64_t n, int64_t k, double alpha, const double* a, - int64_t lda, double beta, double* c, int64_t ldc) { - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_dsyrk_64(&fuplo, &ftrans, &n, &k, &alpha, a, &lda, &beta, c, &ldc); -} - -/* _TRSV */ -template <> -void host_trsv_64(enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation trans, - enum galahad::ssids::cpu::diagonal diag, - int64_t n, const double* a, int64_t lda, - double* x, int64_t incx) { - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char fdiag = (diag==galahad::ssids::cpu::DIAG_UNIT) ? 'U' : 'N'; - spral_c_dtrsv_64(&fuplo, &ftrans, &fdiag, &n, a, &lda, x, &incx); -} - -/* _TRSM */ -template <> -void host_trsm_64(enum galahad::ssids::cpu::side side, - enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation transa, - enum galahad::ssids::cpu::diagonal diag, - int64_t m, int64_t n, double alpha, const double* a, - int64_t lda, double* b, int64_t ldb) { - char fside = (side==galahad::ssids::cpu::SIDE_LEFT) ? 'L' : 'R'; - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftransa = (transa==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char fdiag = (diag==galahad::ssids::cpu::DIAG_UNIT) ? 'U' : 'N'; - spral_c_dtrsm_64(&fside, &fuplo, &ftransa, &fdiag, &m, &n, &alpha, - a, &lda, b, &ldb); -} - -}}} /* namespaces galahad::ssids::cpu */ - -/* =========================== DOUBLE PRECISION ============================= */ - -#else - -extern "C" { - void spral_c_dgemm(char* transa, char* transb, - int* m, int* n, int* k, - double* alpha, const double* a, int* lda, - const double* b, int* ldb, double *beta, - double* c, int* ldc); - void spral_c_dpotrf(char *uplo, int *n, double *a, - int *lda, int *info); - void spral_c_dsytrf(char *uplo, int *n, double *a, - int *lda, int *ipiv, double *work, - int *lwork, int *info); - void spral_c_dtrsm(char *side, char *uplo, char *transa, - char *diag, int *m, int *n, - const double *alpha, const double *a, - int *lda, double *b, int *ldb); - void spral_c_dsyrk(char *uplo, char *trans, - int *n, int *k, double *alpha, - const double *a, int *lda, double *beta, - double *c, int *ldc); - void spral_c_dtrsv(char *uplo, char *trans, char *diag, - int *n, const double *a, int *lda, - double *x, int *incx); - void spral_c_dgemv(char *trans, int *m, int *n, - const double* alpha, const double* a, - int *lda, const double* x, int* incx, - const double* beta, double* y, int* incy); -} - -namespace galahad { namespace ssids { namespace cpu { - -/* _GEMM */ -template <> -void host_gemm(enum galahad::ssids::cpu::operation transa, - enum galahad::ssids::cpu::operation transb, - int m, int n, int k, double alpha, - const double* a, int lda, const double* b, - int ldb, double beta, double* c, int ldc) { - char ftransa = (transa==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char ftransb = (transb==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_dgemm(&ftransa, &ftransb, &m, &n, &k, &alpha, a, &lda, - b, &ldb, &beta, c, &ldc); -} - -/* _GEMV */ -template <> -void gemv(enum galahad::ssids::cpu::operation trans, - int m, int n, double alpha, const double* a, - int lda, const double* x, int incx, - double beta, double* y, int incy) { - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_dgemv(&ftrans, &m, &n, &alpha, a, &lda, x, &incx, - &beta, y, &incy); -} - -/* _POTRF */ -template<> -int lapack_potrf(enum galahad::ssids::cpu::fillmode uplo, - int n, double* a, int lda) { - char fuplo; - switch(uplo) { - case galahad::ssids::cpu::FILL_MODE_LWR: fuplo = 'L'; break; - case galahad::ssids::cpu::FILL_MODE_UPR: fuplo = 'U'; break; - default: throw std::runtime_error("Unknown fill mode"); - } - int info; - spral_c_dpotrf(&fuplo, &n, a, &lda, &info); - return info; -} - -/* _SYTRF - Bunch-Kaufman factorization */ -template<> -int lapack_sytrf(enum galahad::ssids::cpu::fillmode uplo, - int n, double* a, int lda, int *ipiv, - double* work, int lwork) { - char fuplo; - switch(uplo) { - case galahad::ssids::cpu::FILL_MODE_LWR: fuplo = 'L'; break; - case galahad::ssids::cpu::FILL_MODE_UPR: fuplo = 'U'; break; - default: throw std::runtime_error("Unknown fill mode"); - } - int info; - spral_c_dsytrf(&fuplo, &n, a, &lda, ipiv, work, &lwork, &info); - return info; -} - -/* _SYRK */ -template <> -void host_syrk(enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation trans, - int n, int k, double alpha, const double* a, - int lda, double beta, double* c, int ldc) { - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - spral_c_dsyrk(&fuplo, &ftrans, &n, &k, &alpha, a, &lda, &beta, c, &ldc); -} - -/* _TRSV */ -template <> -void host_trsv(enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation trans, - enum galahad::ssids::cpu::diagonal diag, - int n, const double* a, int lda, - double* x, int incx) { - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftrans = (trans==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char fdiag = (diag==galahad::ssids::cpu::DIAG_UNIT) ? 'U' : 'N'; - spral_c_dtrsv(&fuplo, &ftrans, &fdiag, &n, a, &lda, x, &incx); -} - -/* _TRSM */ -template <> -void host_trsm(enum galahad::ssids::cpu::side side, - enum galahad::ssids::cpu::fillmode uplo, - enum galahad::ssids::cpu::operation transa, - enum galahad::ssids::cpu::diagonal diag, - int m, int n, double alpha, const double* a, - int lda, double* b, int ldb) { - char fside = (side==galahad::ssids::cpu::SIDE_LEFT) ? 'L' : 'R'; - char fuplo = (uplo==galahad::ssids::cpu::FILL_MODE_LWR) ? 'L' : 'U'; - char ftransa = (transa==galahad::ssids::cpu::OP_N) ? 'N' : 'T'; - char fdiag = (diag==galahad::ssids::cpu::DIAG_UNIT) ? 'U' : 'N'; - spral_c_dtrsm(&fside, &fuplo, &ftransa, &fdiag, &m, &n, &alpha, - a, &lda, b, &ldb); -} - -}}} /* namespaces galahad::ssids::cpu */ -#endif -#endif - - - - - - - - - - - diff --git a/src/ssls/SSLS.template b/src/ssls/SSLS.template index bb0b44e19e..1e4946b8e3 100644 --- a/src/ssls/SSLS.template +++ b/src/ssls/SSLS.template @@ -3,5 +3,5 @@ ! print-level 0 ! space-critical no ! deallocate-error-fatal no -! symmetric-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt ! output-line-prefix "" diff --git a/src/ssls/ssls.F90 b/src/ssls/ssls.F90 index 2560f1e1da..ff4e7444a6 100644 --- a/src/ssls/ssls.F90 +++ b/src/ssls/ssls.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.3 - 2025-10-23 AT 10:10 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 10:10 GMT. #include "galahad_modules.h" @@ -98,7 +98,7 @@ MODULE GALAHAD_SSLS_precision ! symmetric indefinite linear equation solver - CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "ssids" // & + CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "slblt" // & REPEAT( ' ', 25 ) ! all output lines will be prefixed by @@ -308,7 +308,7 @@ SUBROUTINE SSLS_read_specfile( control, device, alt_specname ) ! print-level 0 ! space-critical F ! deallocate-error-fatal F -! symmetric-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt ! output-line-prefix "" ! END SSLS SPECIFICATIONS diff --git a/src/ssls/sslst.F90 b/src/ssls/sslst.F90 index 173b1ded73..25450aaef7 100644 --- a/src/ssls/sslst.F90 +++ b/src/ssls/sslst.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.3 - 2025-07-29 AT 14:30 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 14:30 GMT. #include "galahad_modules.h" PROGRAM GALAHAD_SSLS_EXAMPLE USE GALAHAD_KINDS_precision @@ -264,7 +264,7 @@ PROGRAM GALAHAD_SSLS_EXAMPLE CASE ( 4 ) control%symmetric_linear_solver = 'ma86' CASE ( 5 ) - control%symmetric_linear_solver = 'ssids' + control%symmetric_linear_solver = 'slblt' CASE ( 6 ) control%symmetric_linear_solver = 'ma97' CASE ( 7 ) @@ -282,7 +282,7 @@ PROGRAM GALAHAD_SSLS_EXAMPLE CASE ( 13 ) CYCLE CASE ( 14 ) - control%symmetric_linear_solver = 'ssids' + control%symmetric_linear_solver = 'slblt' END SELECT IF ( ALLOCATED( H%type ) ) DEALLOCATE( H%type ) CALL SMT_put( H%type, 'COORDINATE', smt_stat ) ; H%ne = h_ne diff --git a/src/symbols/symbols.F90 b/src/symbols/symbols.F90 index 8c46a41ae0..2ab79cba25 100644 --- a/src/symbols/symbols.F90 +++ b/src/symbols/symbols.F90 @@ -194,7 +194,7 @@ MODULE GALAHAD_SYMBOLS INTEGER ( KIND = ip_ ), PUBLIC, PARAMETER :: & GALAHAD_error_metis = - 71 INTEGER ( KIND = ip_ ), PUBLIC, PARAMETER :: & - GALAHAD_error_spral = - 72 + GALAHAD_error_slblt = - 72 INTEGER ( KIND = ip_ ), PUBLIC, PARAMETER :: & GALAHAD_warning_repeated_entry = - 73 INTEGER ( KIND = ip_ ), PUBLIC, PARAMETER :: & @@ -818,9 +818,9 @@ SUBROUTINE SYMBOLS_status( status, out, prefix, routine ) WRITE( out, "( /, A, ' Error return from ', A, ' -', /, A, & & ' METIS failure: check its return status' )" ) & prefix, routine, prefix - CASE( GALAHAD_error_spral ) + CASE( GALAHAD_error_slblt ) WRITE( out, "( /, A, ' Error return from ', A, ' -', /, A, & - & ' SPRAL failure: check its return status' )" ) & + & ' SLBLT failure: check its return status' )" ) & prefix, routine, prefix CASE( GALAHAD_error_ls28 ) WRITE( out, "( /, A, ' Error return from ', A, ' -', /, A, & diff --git a/src/hw/makemaster b/src/topology/makemaster similarity index 56% rename from src/hw/makemaster rename to src/topology/makemaster index 65932a1941..17bc33867e 100644 --- a/src/hw/makemaster +++ b/src/topology/makemaster @@ -1,4 +1,4 @@ -# Main body of the installation makefile for the GALAHAD HW package +# Main body of the installation makefile for the GALAHAD TOPOLOGY package # SPRAL HW_TOPOLOGY was developed as part of SPRAL by Jonathan Hogg # (now at Apple) and is available under a BSD licence as part of GALAHAD @@ -27,18 +27,6 @@ else METIS_64 = endif -ifeq "$(HWLOC)" "un" - DHWLOC = -DSPRAL_NO_HWLOC -else - DHWLOC = -DSPRAL_HAVE_HWLOC -endif - -ifeq "$(GETCPU)" "un" - DGETCPU = -DSPRAL_NO_SCHED_GETCPU -else - DGETCPU = -DSPRAL_HAVE_SCHED_GETCPU -endif - ifeq "$(MULTIVERSIONS)" "yes" MULTI = -DMULTIPRECISION else @@ -76,27 +64,9 @@ CFLAGS = $(CCBASIC) $(OPTIMIZATION) $(CCDEBUG) \ CFLAGSN = $(CCBASIC) $(NOOPTIMIZATION) $(CCDEBUG) \ $(CPPDEFINES) -I $(GALAHAD)/include -I ./include -# C++ compiler flags - -CXXFLAGSOMP = $(CXXBASIC) $(OPTIMIZATION) $(CXXDEBUG) $(SOMP) \ - $(CPPDEFINES) $(DHWLOC) $(DGETCPU) -I $(GALINCLUDE) -CXXFLAGSNOMP = $(CXXBASIC) $(NOOPTIMIZATION) $(CXXDEBUG) $(SOMP) \ - $(CPPDEFINES) $(DHWLOC) $(DGETCPU) -I $(GALINCLUDE) - -# CUDA compiler flags - -#CUDAFLAGS = -arch=$(CUDAARCH) -code=$(CUDACODE) $(CUDABASIC) \ -# $(OPTIMIZATION) -I $(GALINCLUDE) -#CUDAFLAGSN = -arch=$(CUDAARCH) -code=$(CUDACODE) $(CUDABASIC) \ -# $(NOOPTIMIZATION) -I$(GALINCLUDE) - -CUDAFLAGS = $(CUDABASIC) $(CUDAOPTIMIZATION) -I$(GALINCLUDE) -CUDAFLAGSN = $(CUDABASIC) $(CUDANOOPTIMIZATION) -I$(GALINCLUDE) - # linking and run flags RUNFFLAGS = $(OPTIMIZATION) $(DEBUG) $(MODULES) -RUNFFLAGSCUDA = $(OPTIMIZATION) $(MODULES) RUNFFLAGSOMP = $(OPTIMIZATION) $(DEBUG) $(MODULES) $(SOMP) # names of random libraries @@ -129,10 +99,10 @@ CLGQ64 = $(OBJQ64)/libgalahad.a ifeq "$(METIS_64)" "_64" LIBS = -L$(OBJ) $(METIS464ND) $(METIS564ND) $(LAPACK) $(BLAS) \ - -lgalahad $(METIS464ND) $(METIS564ND) $(HSL) -lstdc++ -lhwloc + -lgalahad $(METIS464ND) $(METIS564ND) $(HSL) else LIBS = -L$(OBJ) $(METIS4ND) $(METIS5ND) $(LAPACK) $(BLAS) \ - -lgalahad $(METIS4ND) $(METIS5ND) $(HSL) -lstdc++ -lhwloc + -lgalahad $(METIS4ND) $(METIS5ND) $(HSL) endif PLIBS = $(LIBS) -lgalahad_problem @@ -162,52 +132,52 @@ SUCC = precision version) compiled successfully # compilation agenda -HWS = kinds $(CLGS)(compat.o) $(CLGS)(guess_topology.o) $(LGS)(hw.o) -HWD = kinds $(CLGD)(compat.o) $(CLGD)(guess_topology.o) $(LGD)(hw.o) -HWQ = kinds $(CLGQ)(compat.o) $(CLGQ)(guess_topology.o) $(LGQ)(hw.o) -HWS64 = kinds $(CLGS64)(compat.o) $(CLGS64)(guess_topology.o) $(LGS64)(hw.o) -HWD64 = kinds $(CLGD64)(compat.o) $(CLGD64)(guess_topology.o) $(LGD64)(hw.o) -HWQ64 = kinds $(CLGQ64)(compat.o) $(CLGQ64)(guess_topology.o) $(LGQ64)(hw.o) +HWS = kinds $(LGS)(topology.o) +HWD = kinds $(LGD)(topology.o) +HWQ = kinds $(LGQ)(topology.o) +HWS64 = kinds $(LGS64)(topology.o) +HWD64 = kinds $(LGD64)(topology.o) +HWQ64 = kinds $(LGQ64)(topology.o) # main compilations and runs -all: hw +all: topology -# hw +# topology -hw_silent: hw_silent_$(PRECIS) -hw_silent_single: $(HWS) +topology_silent: topology_silent_$(PRECIS) +topology_silent_single: $(HWS) $(RANLIB) $(LGS) $(RANLIB) $(CLGS) -hw_silent_double: $(HWD) +topology_silent_double: $(HWD) $(RANLIB) $(LGD) $(RANLIB) $(CLGD) -hw_silent_quadruple: $(HWQ) +topology_silent_quadruple: $(HWQ) $(RANLIB) $(LGQ) $(RANLIB) $(CLGQ) -hw_silent_single_64: $(HWS64) +topology_silent_single_64: $(HWS64) $(RANLIB) $(LGS64) $(RANLIB) $(CLGS64) -hw_silent_double_64: $(HWD64) +topology_silent_double_64: $(HWD64) $(RANLIB) $(LGD64) $(RANLIB) $(CLGD64) -hw_silent_quadruple_64: $(HWQ64) +topology_silent_quadruple_64: $(HWQ64) $(RANLIB) $(LGQ64) $(RANLIB) $(CLGQ64) -hw: hw_$(PRECIS) - @printf ' %-21s\n' "GALAHAD: HW ($(PRECIS) $(SUCC)" -hw_single: $(HWS) +topology: topology_$(PRECIS) + @printf ' %-21s\n' "GALAHAD: TOPOLOGY ($(PRECIS) $(SUCC)" +topology_single: $(HWS) $(RANLIB) $(LGS) -hw_double: $(HWD) +topology_double: $(HWD) $(RANLIB) $(LGD) -hw_quadruple: $(HWQ) +topology_quadruple: $(HWQ) $(RANLIB) $(LGQ) -hw_single_64: $(HWS64) +topology_single_64: $(HWS64) $(RANLIB) $(LGS64) -hw_double_64: $(HWD64) +topology_double_64: $(HWD64) $(RANLIB) $(LGD64) -hw_quadruple_64: $(HWQ64) +topology_quadruple_64: $(HWQ64) $(RANLIB) $(LGQ64) # basic packages @@ -218,51 +188,24 @@ kinds: # individual compilations -compat.o: $(CLG)(compat.o) - -$(CLG)(compat.o): ../hw/compat.cxx \ - $(GALINCLUDE)/ssids_compat.hxx - @printf ' %-9s %-15s\t\t' "Compiling" "compat " - $(CP) ../hw/compat.cxx $(OBJ)/ - cd $(OBJ) ; $(CXX) -I. -o compat.o $(CXXFLAGSOMP) compat.cxx \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CXX) -I. -o compat.o $(CXXFLAGSNCOMP) compat.cxx ) - cd $(OBJ) ; $(CARR) compat.o ; $(RM) compat.cxx compat.o - @printf '[ OK ]\n' - -guess_topology.o: $(CLG)(guess_topology.o) - -$(CLG)(guess_topology.o): ../hw/guess_topology.cxx \ - $(GALINCLUDE)/galahad_guess_topology.hxx - @printf ' %-9s %-15s\t\t' "Compiling" "guess_topology " - $(CP) ../hw/guess_topology.cxx $(OBJ)/ - cd $(OBJ) ; $(CXX) -I. -o guess_topology.o $(CXXFLAGSOMP) \ - guess_topology.cxx \ - || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(CXX) -I. -o guess_topology.o $(CXXFLAGSNOMP) \ - guess_topology.cxx ) - cd $(OBJ) ; $(CARR) guess_topology.o ; \ - $(RM) guess_topology.cxx guess_topology.o - @printf '[ OK ]\n' - -hw.o: $(LG)(hw.o) +topology.o: $(LG)(topology.o) -$(LG)(hw.o): ../hw/hw.F90 - @printf ' %-9s %-15s\t\t' "Compiling" "hw " - $(CP) ../hw/hw.F90 $(OBJ)/hw.F90 - cd $(OBJ) ; $(FORTRAN) -o hw.o $(FFLAGSOMP) hw.F90 \ +$(LG)(topology.o): ../topology/topology.F90 + @printf ' %-9s %-15s\t\t' "Compiling" "topology " + $(CP) ../topology/topology.F90 $(OBJ)/topology.F90 + cd $(OBJ) ; $(FORTRAN) -o topology.o $(FFLAGSOMP) topology.F90 \ || ( printf ' %-26s' "=> Disabling optimization " ; \ - $(FORTRAN) -o hw.o $(FFLAGSNOMP) hw.F90 ) - cd $(OBJ) ; $(ARR) hw.o ; $(RM) hw.F90 hw.o - $(RRMARFILE) ssids_$(PRECIS).o + $(FORTRAN) -o topology.o $(FFLAGSNOMP) topology.F90 ) + cd $(OBJ) ; $(ARR) topology.o ; $(RM) topology.F90 topology.o + $(RRMARFILE) slblt_$(PRECIS).o $(MVMODS) @printf '[ OK ]\n' # book keeping clean: - @printf ' %-9s %-15s\t\t' "Cleaning $(PRECIS) precision hw" - $(RM) $(LGS) $(LGD) $(OBJ)/hw*.o $(OBJ)/libgalahad.a \ + @printf ' %-9s %-15s\t\t' "Cleaning $(PRECIS) precision topology" + $(RM) $(LGS) $(LGD) $(OBJ)/topology*.o $(OBJ)/libgalahad.a \ $(OBJ)/libgalahad_c.a $(MOD)/galahad* @printf '[ OK ]\n' @@ -272,7 +215,7 @@ cleanall: $(RM) -r $(OBJ)/* $(MOD)/* @printf '[ OK ]\n' -rmhw: - @printf ' %-9s %-15s\t\t' "Removing" "hw from archive " - $(RRMARFILE) hw_$(PRECIS).o +rmtopology: + @printf ' %-9s %-15s\t\t' "Removing" "topology from archive " + $(RRMARFILE) topology_$(PRECIS).o @printf '[ OK ]\n' diff --git a/src/topology/meson.build b/src/topology/meson.build new file mode 100644 index 0000000000..d65899e331 --- /dev/null +++ b/src/topology/meson.build @@ -0,0 +1 @@ +libgalahad_src += files('topology.F90') diff --git a/src/topology/topology.F90 b/src/topology/topology.F90 new file mode 100644 index 0000000000..62b13aa51d --- /dev/null +++ b/src/topology/topology.F90 @@ -0,0 +1,290 @@ +! THIS VERSION: GALAHAD 5.5 - 2026-07-27 AT 11:25 GMT. + +#include "galahad_modules.h" + +!-*-*-*-*- G A L A H A D _ T O P O L O G Y M O D U L E -*-*-*-*-*-*-*- + +! Copyright reserved, Gould/Orban/Toint, for GALAHAD productions +! Principal author: Alexis Montoison + +! Pure-Fortran hardware-topology detection. +! On Linux the NUMA layout is read straight from sysfs +! (/sys/devices/system/node/nodeN/cpulist): one region per NUMA node, +! with nproc = number of physical cores in that node -- counted from +! each CPU's topology/thread_siblings_list, so hyperthreads collapse onto their +! core, matching hwloc's former core count. If the per-CPU topology cannot be +! read it falls back to the logical-CPU count, and if sysfs is unavailable +! (non-Linux, or no NUMA info) to a single region spanning all OpenMP threads. + + MODULE GALAHAD_TOPOLOGY + +! provides routines for detecting and/or specifying hardware topology for +! topology-aware routines + + USE GALAHAD_KINDS, ONLY: ip_ +!$ USE omp_lib, ONLY: omp_get_max_threads + IMPLICIT NONE + + PRIVATE + PUBLIC :: TOPOLOGY_numa_region, TOPOLOGY_guess_topology + +! derived type describing regions + + TYPE :: TOPOLOGY_numa_region + +! number of processors in region + + INTEGER ( KIND = ip_ ) :: nproc + END TYPE TOPOLOGY_numa_region + + CONTAINS + +!-*-*-*-*- H W _ G U E S S _ T O P O L O G Y S U B R O U T I N E -*-*-*-* + + SUBROUTINE TOPOLOGY_guess_topology( regions, st ) + +! return best guess for machine topology: one region per Linux NUMA node +! (from sysfs), else a single region spanning all OpenMP threads + +! upon return allocated to have size equal to the number of NUMA regions. +! The members describe each region + + TYPE ( TOPOLOGY_numa_region ), DIMENSION( : ), ALLOCATABLE, & + INTENT( OUT ) :: regions + +! status return from allocate. If non-zero upon return, an allocation failed + + INTEGER ( KIND = ip_ ), INTENT( OUT ) :: st + + INTEGER ( KIND = ip_ ) :: i, nnode, nproc + LOGICAL :: ex + + st = 0 + +! count NUMA nodes exposed by the kernel (probe nodeN until one is missing) + + nnode = 0 + DO i = 0, 8191 + INQUIRE( FILE = node_cpulist_path( i ), EXIST = ex ) + IF ( .NOT. ex ) EXIT + nnode = nnode + 1 + END DO + +! build one region per NUMA node from its cpulist + + IF ( nnode > 0 ) THEN + ALLOCATE ( regions( nnode ), STAT = st ) + IF ( st /= 0 ) RETURN + DO i = 1, nnode + nproc = count_cores( node_cpulist_path( i - 1 ) ) ! physical cores + IF ( nproc <= 0 ) & + nproc = count_cpulist( node_cpulist_path( i - 1 ) ) ! -> logical + IF ( nproc <= 0 ) THEN ! unreadable/empty -> give up on sysfs + DEALLOCATE ( regions, STAT = st ) + nnode = 0 + EXIT + END IF + regions( i )%nproc = nproc + END DO + END IF + +! fallback: a single region spanning all available OpenMP threads + + IF ( nnode <= 0 ) THEN + nproc = 1 +!$ nproc = INT( omp_get_max_threads( ), ip_ ) + ALLOCATE ( regions( 1 ), STAT = st ) + IF ( st /= 0 ) RETURN + regions( 1 )%nproc = nproc + END IF + + RETURN + END SUBROUTINE TOPOLOGY_guess_topology + +!-*-*-*-*-*-*-*-*-*-*-*- h e l p e r s -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*- + +! sysfs path of NUMA node `node`'s cpulist + + FUNCTION node_cpulist_path( node ) RESULT( path ) + INTEGER ( KIND = ip_ ), INTENT( IN ) :: node + CHARACTER ( LEN = 64 ) :: path + CHARACTER ( LEN = 16 ) :: num + WRITE( num, '( I0 )' ) node + path = '/sys/devices/system/node/node' // TRIM( num ) // '/cpulist' + END FUNCTION node_cpulist_path + +! count the logical CPUs listed in a Linux cpulist file, whose contents look +! like "0-15" or "0-7,16-23" or "3" (comma-separated ranges / singletons); +! returns 0 if the file cannot be read + + FUNCTION count_cpulist( path ) RESULT( ncpu ) + CHARACTER ( LEN = * ), INTENT( IN ) :: path + INTEGER ( KIND = ip_ ) :: ncpu + CHARACTER ( LEN = 8192 ) :: line + INTEGER :: unit, ios, i, n, lo, hi, dash, p + CHARACTER ( LEN = 64 ) :: tok + + ncpu = 0 + OPEN( NEWUNIT = unit, FILE = path, STATUS = 'OLD', ACTION = 'READ', & + IOSTAT = ios ) + IF ( ios /= 0 ) RETURN + line = '' + READ( unit, '( A )', IOSTAT = ios ) line + CLOSE( unit ) + IF ( ios /= 0 ) RETURN + +! split on commas, each token is either "lo-hi" or "v" + + n = LEN_TRIM( line ) + i = 1 + DO WHILE ( i <= n ) + p = INDEX( line( i : n ), ',' ) + IF ( p == 0 ) THEN + tok = line( i : n ); i = n + 1 + ELSE + tok = line( i : i + p - 2 ); i = i + p + END IF + tok = ADJUSTL( tok ) + IF ( LEN_TRIM( tok ) == 0 ) CYCLE + dash = INDEX( tok, '-' ) + IF ( dash == 0 ) THEN + ncpu = ncpu + 1 + ELSE + READ( tok( 1 : dash - 1 ), * , IOSTAT = ios ) lo + IF ( ios /= 0 ) CYCLE + READ( tok( dash + 1 : ), * , IOSTAT = ios ) hi + IF ( ios /= 0 ) CYCLE + ncpu = ncpu + ( hi - lo + 1 ) + END IF + END DO + END FUNCTION count_cpulist + +! count the physical cores among the logical CPUs listed in NUMA-node cpulist +! file `path`. Each core is counted once, via its lowest-numbered thread (the +! first entry of that CPU's topology/thread_siblings_list). Returns 0 if the +! cpulist or any sibling file cannot be read, so the caller can fall back to +! the logical-CPU count + + FUNCTION count_cores( path ) RESULT( ncore ) + CHARACTER ( LEN = * ), INTENT( IN ) :: path + INTEGER ( KIND = ip_ ) :: ncore + CHARACTER ( LEN = 8192 ) :: line + INTEGER ( KIND = ip_ ), ALLOCATABLE :: ids( : ) + INTEGER ( KIND = ip_ ) :: nid, k, c, smin + INTEGER :: unit, ios + LOGICAL :: ok + + ncore = 0 + OPEN( NEWUNIT = unit, FILE = path, STATUS = 'OLD', ACTION = 'READ', & + IOSTAT = ios ) + IF ( ios /= 0 ) RETURN + line = '' + READ( unit, '( A )', IOSTAT = ios ) line + CLOSE( unit ) + IF ( ios /= 0 ) RETURN + + CALL expand_cpulist( line, ids, nid ) + IF ( nid <= 0 ) RETURN + + DO k = 1, nid + c = ids( k ) + smin = core_first_sibling( c, ok ) + IF ( .NOT. ok ) THEN ! no per-CPU topology -> caller falls back + ncore = 0 + RETURN + END IF + IF ( smin == c ) ncore = ncore + 1 + END DO + END FUNCTION count_cores + +! expand a Linux cpulist string ("0-7,16-23" or "3") into the array `ids` of +! individual CPU numbers (allocated here); nid is the number of entries + + SUBROUTINE expand_cpulist( line, ids, nid ) + CHARACTER ( LEN = * ), INTENT( IN ) :: line + INTEGER ( KIND = ip_ ), ALLOCATABLE, INTENT( OUT ) :: ids( : ) + INTEGER ( KIND = ip_ ), INTENT( OUT ) :: nid + INTEGER ( KIND = ip_ ) :: lo, hi, v + INTEGER :: n, i, p, dash, ios, pass, cnt + CHARACTER ( LEN = 64 ) :: tok + +! pass 1 counts the ids, pass 2 fills the allocated array + + DO pass = 1, 2 + cnt = 0 + n = LEN_TRIM( line ) + i = 1 + DO WHILE ( i <= n ) + p = INDEX( line( i : n ), ',' ) + IF ( p == 0 ) THEN + tok = line( i : n ); i = n + 1 + ELSE + tok = line( i : i + p - 2 ); i = i + p + END IF + tok = ADJUSTL( tok ) + IF ( LEN_TRIM( tok ) == 0 ) CYCLE + dash = INDEX( tok, '-' ) + IF ( dash == 0 ) THEN + READ( tok, *, IOSTAT = ios ) v + IF ( ios /= 0 ) CYCLE + cnt = cnt + 1 + IF ( pass == 2 ) ids( cnt ) = v + ELSE + READ( tok( 1 : dash - 1 ), *, IOSTAT = ios ) lo + IF ( ios /= 0 ) CYCLE + READ( tok( dash + 1 : ), *, IOSTAT = ios ) hi + IF ( ios /= 0 ) CYCLE + DO v = lo, hi + cnt = cnt + 1 + IF ( pass == 2 ) ids( cnt ) = v + END DO + END IF + END DO + IF ( pass == 1 ) THEN + nid = cnt + ALLOCATE ( ids( MAX( nid, 1 ) ) ) + IF ( nid <= 0 ) RETURN + END IF + END DO + END SUBROUTINE expand_cpulist + +! return the lowest-numbered logical CPU sharing a physical core with `cpu`, +! read from /sys/devices/system/cpu/cpuN/topology/thread_siblings_list (the +! kernel lists siblings in ascending order, so the first integer is the +! minimum). ok is .FALSE. if the file cannot be read + + FUNCTION core_first_sibling( cpu, ok ) RESULT( smin ) + INTEGER ( KIND = ip_ ), INTENT( IN ) :: cpu + LOGICAL, INTENT( OUT ) :: ok + INTEGER ( KIND = ip_ ) :: smin + CHARACTER ( LEN = 128 ) :: path + CHARACTER ( LEN = 16 ) :: num + CHARACTER ( LEN = 8192 ) :: line + INTEGER :: unit, ios, e, p + + smin = cpu ; ok = .FALSE. + WRITE( num, '( I0 )' ) cpu + path = '/sys/devices/system/cpu/cpu' // TRIM( num ) // & + '/topology/thread_siblings_list' + OPEN( NEWUNIT = unit, FILE = path, STATUS = 'OLD', ACTION = 'READ', & + IOSTAT = ios ) + IF ( ios /= 0 ) RETURN + line = '' + READ( unit, '( A )', IOSTAT = ios ) line + CLOSE( unit ) + IF ( ios /= 0 ) RETURN + line = ADJUSTL( line ) + e = LEN_TRIM( line ) + IF ( e < 1 ) RETURN + p = SCAN( line( 1 : e ), ',-' ) ! first integer = up to first sep + IF ( p > 0 ) e = p - 1 + IF ( e < 1 ) RETURN + READ( line( 1 : e ), *, IOSTAT = ios ) smin + IF ( ios /= 0 ) THEN + smin = cpu + RETURN + END IF + ok = .TRUE. + END FUNCTION core_first_sibling + + END MODULE GALAHAD_TOPOLOGY diff --git a/src/trb/trbt.F90 b/src/trb/trbt.F90 index a4cc8e173a..a9dd029b63 100644 --- a/src/trb/trbt.F90 +++ b/src/trb/trbt.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.4 - 2025-11-23 AT 09:35 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 09:35 GMT. #include "galahad_modules.h" PROGRAM GALAHAD_TRB_test USE GALAHAD_USERDATA_precision @@ -429,8 +429,8 @@ PROGRAM GALAHAD_TRB_test SUBROUTINE WHICH_sls( control ) TYPE ( TRB_control_type ) :: control #include "galahad_sls_defaults_ls.h" -!symmetric_linear_solver = 'ssids' -!definite_linear_solver = 'ssids' +!symmetric_linear_solver = 'slblt' +!definite_linear_solver = 'slblt' !definite_linear_solver = 'sytr ' control%TRS_control%symmetric_linear_solver = symmetric_linear_solver control%TRS_control%definite_linear_solver = definite_linear_solver diff --git a/src/trek/TREK.template b/src/trek/TREK.template index 5cea13c488..b1f69e47cc 100644 --- a/src/trek/TREK.template +++ b/src/trek/TREK.template @@ -14,6 +14,6 @@ ! new-values F ! space-critical F ! deallocate-error-fatal F -! linear-equation-solver ssids -! linear-equation-solver-for-S ssids +! linear-equation-solver slblt +! linear-equation-solver-for-S slblt ! output-line-prefix "" diff --git a/src/trek/trek.F90 b/src/trek/trek.F90 index 11d2941afd..f8ec6b1277 100644 --- a/src/trek/trek.F90 +++ b/src/trek/trek.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.4 - 2025-11-17 AT 13:50 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 13:50 GMT. #include "galahad_modules.h" @@ -164,11 +164,11 @@ MODULE GALAHAD_TREK_precision ! symmetric linear equation solver for systems involving H - CHARACTER ( LEN = 30 ) :: linear_solver = "ssids" // REPEAT( ' ', 25 ) + CHARACTER ( LEN = 30 ) :: linear_solver = "slblt" // REPEAT( ' ', 25 ) ! symmetric linear equation solver for systems involving S (if needed) - CHARACTER ( LEN = 30 ) :: linear_solver_for_S = "ssids" // & + CHARACTER ( LEN = 30 ) :: linear_solver_for_S = "slblt" // & REPEAT( ' ', 25 ) ! all output lines will be prefixed by %prefix(2:LEN(TRIM(%prefix))-1) @@ -480,8 +480,8 @@ SUBROUTINE TREK_read_specfile( control, device, alt_specname ) ! new-values F ! space-critical F ! deallocate-error-fatal F -! linear-equation-solver ssids -! linear-equation-solver-for-S ssids +! linear-equation-solver slblt +! linear-equation-solver-for-S slblt ! output-line-prefix "" ! END TREK SPECIFICATIONS (DEFAULT) diff --git a/src/trs/TRS.template b/src/trs/TRS.template index ba9b0e1cf0..7b1f0b2623 100644 --- a/src/trs/TRS.template +++ b/src/trs/TRS.template @@ -24,7 +24,7 @@ ! force-Newton-if-positive-definite no ! space-critical no ! deallocate-error-fatal no -! symmetric-linear-equation-solver ssids -! definite-linear-equation-solver ssids +! symmetric-linear-equation-solver slblt +! definite-linear-equation-solver slblt ! problem-file trs_problem.data ! output-line-prefix "" diff --git a/src/trs/trs.F90 b/src/trs/trs.F90 index b0d71c1633..693283575e 100644 --- a/src/trs/trs.F90 +++ b/src/trs/trs.F90 @@ -1,4 +1,4 @@ -! THIS VERSION: GALAHAD 5.4 - 2025-11-11 AT 08:10 GMT. +! THIS VERSION: GALAHAD 5.6.0 - 2026-08-08 AT 08:10 GMT. #include "galahad_modules.h" @@ -236,12 +236,12 @@ MODULE GALAHAD_TRS_precision ! symmetric (indefinite) linear equation solver - CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "ssids" // & + CHARACTER ( LEN = 30 ) :: symmetric_linear_solver = "slblt" // & REPEAT( ' ', 25 ) ! definite linear equation solver - CHARACTER ( LEN = 30 ) :: definite_linear_solver = "ssids" // & + CHARACTER ( LEN = 30 ) :: definite_linear_solver = "slblt" // & REPEAT( ' ', 25 ) ! all output lines will be prefixed by