Compare commits

..
197 Commits
Author SHA1 Message Date
sfilippone 1395c67d9c Minor fixes to silence Intel compiler warnings. 2026-09-17 11:37:30 +02:00
sfilippone d2122bf4b6 Moving to submodules and fixes for Intel. 2026-09-15 13:36:01 +02:00
sfilippone 72a731ca78 Fix test program 2026-09-09 17:20:42 +02:00
sfilippone e944da5bf7 Merge branch 'remap-coarse' into development 2026-07-14 15:34:52 +02:00
sfilippone 9cf27f6c46 Fix cmp_avg_cr 2026-07-14 10:53:27 +02:00
sfilippone 8ac5b90454 Cleanup of first remapping version. To be tested. 2026-07-14 09:36:47 +02:00
sfilippone 23f84ce236 First working version 2026-07-13 15:42:23 +02:00
sfilippone 42313bb843 First D remapping version. Needs full testing an work on clone 2026-07-11 12:30:28 +02:00
sfilippone b7ac77da69 Fix poly%clone allocation of poly_beta 2026-07-11 12:27:03 +02:00
sfilippone a3e1be46ee Fix matrix generation 2026-05-05 16:45:06 +02:00
sfilippone 3343b039e6 Fix sample matrix generators 2026-05-05 15:52:03 +02:00
sfilippone 5c055170e7 Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2026-05-05 15:34:47 +02:00
sfilippone 0814492adc Mods jac solver 2026-05-05 15:33:45 +02:00
sfilippone 1ae3cc135f Improve error handling for prec%free 2026-05-04 20:50:34 +02:00
sfilippone 246992cb65 Add base matrix info to prec%descr 2026-04-27 13:04:50 +02:00
sfilippone 01cc7ada88 Adjust strategy for stopping on aggregation ratio 2026-04-27 13:04:04 +02:00
sfilippone 8a66a7b214 Handle remap and refactor mlprec_aply 2026-04-22 16:19:08 +02:00
sfilippone 8f0718c296 Adjust wrk_alloc 2026-04-20 14:29:15 +02:00
sfilippone 62f5501761 Fix mlprec_aply 2026-04-20 11:28:06 +02:00
Salvatore Filippone d833362f4b Round of improvements for remap 2026-04-20 08:45:21 +02:00
Salvatore Filippone f26b66334a Comment on onelev. 2026-04-19 12:49:24 +02:00
Salvatore Filippone d45fffe482 Merged MUMPS fixes 2026-04-19 12:49:11 +02:00
sfilippone 693eab66cb Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2026-04-16 14:59:33 +02:00
sfilippone 1a2ec161d7 Improve configry for MUMPS 2026-04-16 14:59:11 +02:00
sfilippone 4642c857d1 Improve MUMPS solver build 2026-04-16 14:58:59 +02:00
sfilippone f99b563f83 New test cases 2026-04-15 15:13:58 +02:00
sfilippone b1c4b08d6e Fix use of remap 2026-04-15 15:13:04 +02:00
sfilippone c8d065fa55 Fix double allocation in DDIAG%BLD 2026-04-15 10:19:50 +02:00
sfilippone 0e1d7de857 Update VERSION 2026-04-10 13:37:51 +02:00
Salvatore Filippone a22725b787 CMakeLists interim version 2026-04-09 14:37:15 +02:00
sfilippone 74a9ca90cb Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2026-04-07 16:24:04 +02:00
sfilippone 0d38955a2d Fix generation of amg_config.h with CMAKE 2026-04-07 16:23:32 +02:00
fdurastante 9be4a3f1be Updated MUMPS link in documentation 2026-04-02 16:28:42 +02:00
sfilippone 04d7122380 Improved error handling in _bld 2026-04-02 13:53:40 +02:00
Salvatore Filippone 087dc37868 Fix handling of external packages within CBIND. 2026-03-25 16:47:30 +01:00
Salvatore Filippone 8e685aa3ae Fix includes for SuperLU and friends in configure 2026-03-24 19:05:35 +01:00
sfilippone 6dbe4c96f2 Take out amg_const.h 2026-03-24 11:44:11 +01:00
sfilippone f012a9d05e Add cpymat optional argument to hierarchy_bld 2026-03-20 13:48:53 +01:00
sfilippone 93ea03ef1c Add .gitattributes 2026-03-20 10:01:04 +01:00
sfilippone 5663188b8c Fix use of AR in configure for other platforms 2026-03-18 16:58:27 +01:00
sfilippone 8ac05fd00e Fix license 2026-03-18 16:12:44 +01:00
sfilippone c278c2a69a Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2026-03-18 14:51:54 +01:00
sfilippone eae53162af Fix licensing text 2026-03-18 14:46:31 +01:00
sfilippone 0b2a212523 Fix message in samples 2026-03-18 14:29:11 +01:00
sfilippone 7b255aaf6f Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2026-03-17 12:29:48 +01:00
sfilippone 4c9687c89b Multiple changes to CBIND and configure 2026-03-17 12:27:59 +01:00
Salvatore Filippone a1952a5bf8 Merge pull request #8 from fdrmrc/fix_C_interface
Fix missing library in C interface linking
2026-03-17 09:16:17 +01:00
Marco Feder d2070bcc05 Fix Makefile. Add psb_ext 2026-03-17 00:37:59 +01:00
sfilippone f760396403 Fix compilation for new use of MPIC 2026-03-13 14:40:00 +01:00
sfilippone 8f259367de Merge branch 'gpucinterfaces' of github.com:sfilippone/amg4psblas into gpucinterfaces 2026-01-27 14:49:48 +01:00
fdurastante 15d1386b73 Removed debug prints, fixed name of function in error strings 2026-01-27 14:46:35 +01:00
sfilippone 14d24b1d7c Inconsistent C function names 2026-01-27 12:32:46 +01:00
sfilippone 92425e2478 Merge branch 'gpucinterfaces' of github.com:sfilippone/amg4psblas into gpucinterfaces 2026-01-27 12:19:52 +01:00
sfilippone 228f4e46a9 Fix select type 2026-01-27 12:15:14 +01:00
fdurastante 492ae602f2 Added interface for smoother build. Improved options for preconditioner. There is still a memory error. 2026-01-23 14:29:21 +01:00
fdurastante 3230c70308 Standard input file for GPU experiment 2026-01-23 09:40:51 +01:00
fdurastante eb99c74fae Added L1-Jacobi smoother 2026-01-23 08:15:13 +01:00
fdurastante 1c69b2f635 Tester compiling, but misterious CUDA double free to be debugged 2026-01-22 14:35:30 +01:00
sfilippone 86731fe5bb Fix makefiles 2026-01-19 11:46:20 +01:00
fdurastante 7a5ba06622 Added interface for the allocate_wrk member function of a preconditioner. It handles also allocation on the CUDA/GPU side. 2026-01-16 14:08:36 +01:00
sfilippone d4c0428704 Add FCUDEFINES for CBIND 2026-01-16 12:24:22 +01:00
sfilippone 1a969488e3 Merge branch 'gpucinterfaces' of github.com:sfilippone/amg4psblas into gpucinterfaces 2026-01-15 15:27:53 +01:00
Salvatore Filippone 95382fbb01 Fix use of psb_stringc2f 2026-01-15 15:26:11 +01:00
sfilippone f586df1ac3 Fix use of stringc2f 2026-01-15 11:40:36 +01:00
Salvatore Filippone bab8a27962 Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2026-01-13 17:45:52 +01:00
sfilippone 28ccefa4bb Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2026-01-13 17:43:25 +01:00
sfilippone 3f33b2ce71 Update docs 2026-01-13 17:41:47 +01:00
Salvatore Filippone 7279347055 Doc fixes 2025-12-30 19:42:01 +01:00
sfilippone e627667f3c README updates 2025-12-23 11:50:39 +01:00
sfilippone 1557bcc45b Docs update 2025-12-23 11:37:01 +01:00
sfilippone 786abaff97 Bump minimum PSBLAS requirement to 3.9.0 2025-12-23 11:22:04 +01:00
sfilippone 06f8f83114 Update documentation for release 2025-12-23 11:21:53 +01:00
sfilippone 43a75e3171 Delete configure_n 2025-12-23 11:21:12 +01:00
Salvatore Filippone 2bde1beda2 README updates 2025-12-22 10:50:22 +01:00
Luca Pepè Sciarria 7d110a88d0 Update README.md with CMake building instuction 2025-12-22 10:42:43 +01:00
Salvatore Filippone f915372c99 Bump minimum prereq PSBLAS to 3.9.0. Document. 2025-12-20 21:02:32 +01:00
sfilippone b5df1842e0 Update handling of AMG_SLU_VERSION in configure and interface 2025-12-19 14:03:33 +01:00
sfilippone a6267d8e67 Update configure and interfaces for SUPERLU version 7. 2025-12-19 12:49:45 +01:00
Salvatore Filippone 498f8bd482 README updates 2025-12-17 18:24:55 +01:00
Salvatore Filippone 7aef98fc09 Improved error messaging for sample programs. Fix PDE2D 2025-12-17 14:14:19 +01:00
sfilippone 31a44360a4 Update for PSBLAS_CBIND switching to LINSOLVE 2025-12-09 10:25:02 +01:00
Salvatore Filippone 83a668c1e0 Improve Makefile dependencies 2025-11-22 12:05:20 +01:00
sfilippone c162633845 Merge branch 'cmake' into development 2025-11-21 11:42:51 +01:00
sfilippone 547c4f3a60 Fix template typo in KRM_SOLVER_IMPL 2025-11-20 14:59:15 +01:00
sfilippone 92766e743a Improved messaging from configure 2025-11-19 14:36:42 +01:00
sfilippone 212892e84a Silly bug in zprec cbind 2025-11-17 17:37:30 +01:00
Salvatore Filippone f9c0eec453 Fix overshooting tables. 2025-11-15 19:15:15 +01:00
sfilippone 387d6bef74 Fixes for compilation with IPK=8 2025-11-11 10:00:58 +01:00
sfilippone d6550abc70 Fix use psb_linsolve in the manual 2025-11-04 16:08:26 +01:00
Salvatore Filippone d95341b45a Typo in README.md 2025-10-20 09:30:22 +02:00
fdurastante 7da64944b5 Exposed prec%apply on the C interfaces 2025-10-14 18:04:12 +02:00
sfilippone daaa06e486 Fix USE statement 2025-09-23 16:16:08 +02:00
sfilippone 5ee819592f Fixes for compilation with INTEL 2025-09-23 13:12:10 +02:00
Luca Pepè Sciarria 5408e16a4a hot fix: add -ffree-line-length-256 compilation flag for fortran 2025-06-16 16:46:07 +02:00
Luca Pepè Sciarria 372ef708e0 hot fix: now it build cbind with the right source files 2025-06-16 11:41:39 +02:00
Luca Pepè Sciarria f4e1ba97e9 add mpi compilation 2025-06-13 13:15:43 +02:00
Luca Pepè Sciarria e429b04600 work on cpp part of amgprec. Still not working 2025-06-13 13:15:00 +02:00
Luca Pepè Sciarria 6c12de02e8 add cxx mpi version 2025-06-10 09:50:56 +02:00
Luca Pepè Sciarria 0cb2c1c0c6 hot fix 2025-06-10 08:37:17 +02:00
Luca Pepè Sciarria 7c153de54a add cpp file compilation; fix mpi compilation 2025-06-09 17:18:37 +02:00
Luca Pepè Sciarria 00cf38906a Merge branch 'cmake' of github.com:sfilippone/amg4psblas into cmake 2025-06-09 14:11:10 +02:00
Luca Pepè Sciarria 23cf86a797 hot fix: change filename extensions to F90 2025-06-09 14:10:45 +02:00
sfilippone 91bea72cfe Merge branch 'development' into cmake 2025-06-09 10:53:16 +02:00
Luca Pepè Sciarria 9a36a321f2 fix cmake 2025-06-09 10:13:05 +02:00
Luca Pepè Sciarria 60d722ec53 fix cmake 2025-06-09 10:09:28 +02:00
Luca Pepè Sciarria 1b8aa1618e fix cmake 2025-06-09 10:06:50 +02:00
Luca Pepè Sciarria 154e88cd69 hot fix 2025-06-09 09:46:59 +02:00
Luca Pepè Sciarria cf93042e42 now the cmake building works and compiles 2025-06-09 09:42:08 +02:00
Luca Pepè Sciarria ecaea5b794 hot fix: correct name for amg4psblas libraries 2025-06-09 09:39:21 +02:00
Luca Pepè Sciarria 3a42a2597c fix CMake building and compilation 2025-06-06 16:38:50 +02:00
Luca Pepè Sciarria fcf48ee614 hot fix: Config.cmake files now is properly installed 2025-06-06 16:11:59 +02:00
Salvatore Filippone 0ddd35b7b6 Users guide update 2025-06-06 11:12:52 +02:00
Luca Pepè Sciarria 4c19edb2f9 add CMakeLists.txt for samples subprojects 2025-06-06 10:15:55 +02:00
Luca Pepè Sciarria c7c02bf7c0 hot fix, change installation folder name from test to samples 2025-06-06 10:14:38 +02:00
sfilippone 7050095ca5 Users guide updates 2025-06-05 19:02:42 +02:00
Luca Pepè Sciarria b7edff0848 Merge branch 'development' into cmake 2025-06-05 16:31:58 +02:00
Luca Pepè Sciarria 6214a918f1 add installation of test under samples 2025-06-05 16:24:43 +02:00
sfilippone b724a324c9 Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2025-06-05 09:41:07 +02:00
sfilippone 21b85bc533 Update contributor list 2025-06-05 09:39:50 +02:00
sfilippone 3176a53a61 Merge branch 'development' into cmake 2025-06-03 09:33:15 +02:00
sfilippone b246223597 Fixes for IPK8 2025-06-01 20:57:09 +02:00
sfilippone 2f4c9dd579 Improve diagnostic printout in samples 2025-05-26 12:00:49 +02:00
Luca Pepè Sciarria 657986c938 Merge branch 'cmake' of github.com:sfilippone/amg4psblas into cmake 2025-04-17 14:35:48 +02:00
Luca Pepè Sciarria 687e0824e8 change how PSBLAS_INSTALL_DIR is set 2025-04-17 14:35:36 +02:00
Luca Pepè Sciarria 7abeb7d192 hot fix 2025-04-17 13:56:34 +02:00
Luca Pepè Sciarria 196cedfedb correct PSB_IPK/LPK flags, now set only for fortran compiler 2025-04-17 13:51:02 +02:00
Luca Pepè Sciarria 120da08860 remove fortran name mangling 2025-04-17 13:50:13 +02:00
Luca Pepè Sciarria 70b28ddc08 change install directory 2025-04-17 13:49:34 +02:00
sfilippone 22b37fa6d3 Fix REPL with MATCHBOXP 2025-04-16 15:02:52 +02:00
sfilippone 8fdff8e33b Merge branch 'cmake' of github.com:sfilippone/amg4psblas into cmake 2025-04-11 11:36:03 +02:00
Luca Pepè Sciarria 0d07a81aa7 add PSB_IPK and PSB_LPK compilation flags 2025-04-11 11:35:10 +02:00
sfilippone 64d2ead7a0 Merge branch 'cmake' of github.com:sfilippone/amg4psblas into cmake 2025-04-11 09:57:04 +02:00
Luca Pepè Sciarria e762554627 update to reflect the changes in development regarding amg_config.h file 2025-04-11 09:55:13 +02:00
Luca Pepè Sciarria b5e7d6aaaa Merge branch 'development' into cmake 2025-04-11 09:21:51 +02:00
sfilippone 886e03ab65 Merge branch 'development' into cmake 2025-04-10 17:43:45 +02:00
Luca Pepè Sciarria a0fc174c84 add import of psblas installation paths 2025-04-10 14:42:43 +02:00
sfilippone bbf5cc9826 Improve samples output formatting 2025-03-28 15:01:58 +01:00
Salvatore Filippone 8337edb362 Switch off detailed timings 2025-03-27 17:16:22 +01:00
sfilippone a39cd229e0 Improved dependencies in main makefile 2025-03-27 12:40:36 +01:00
sfilippone a983f95fc2 Add error handling after CDALL in samples 2025-03-27 12:40:31 +01:00
sfilippone aa03a1cafd Add discretization domain size 2025-03-24 17:31:52 +01:00
sfilippone f3123f1acc Improve output of memory occupation 2025-03-24 17:23:42 +01:00
fdurastante ed8b3d5c9e Fixed Sample to use AS 2025-03-24 13:53:52 +01:00
sfilippone 787b99b320 Fix input files. 2025-03-24 10:25:05 +01:00
fdurastante c07dad642f Add options for KRM coarse solver in fileread
example.
2025-03-24 09:06:41 +01:00
sfilippone 75f768028c Fixes code and copyright for serial matching. 2025-03-23 12:11:47 +01:00
sfilippone afb5d9da76 Fix use of BIT64 in MatchBox 2025-03-22 20:29:44 +01:00
sfilippone b9cf9dca06 Merge branch 'serial-match' into development 2025-03-21 14:10:39 +01:00
sfilippone e922582aad Various fixes for PSB_ and SERIAL_MPI with matching 2025-03-21 14:07:44 +01:00
sfilippone 9ad88b1355 Take out MUMPS interface debug statement 2025-03-21 12:13:39 +01:00
sfilippone 0f425bdc06 Fix configure for MUMPS with INCLUDES instead of MODULES 2025-03-21 11:54:05 +01:00
sfilippone d925d39089 Take out OpenMP in samples generation for the time being 2025-03-20 10:14:49 +01:00
fdurastante 92eb261ee5 Exclude generated amg_config.h from tracking 2025-03-20 09:02:46 +01:00
fdurastante 5cf7d5b3c1 Added KRM options for coarse solver 2025-03-19 23:54:27 +01:00
sfilippone 31644c972a Fix usage of --enable-XXX 2025-03-19 14:33:32 +01:00
sfilippone cfd29707da New amg_config.h.in 2025-03-19 14:11:13 +01:00
sfilippone 9ded460701 Fix #defines 2025-03-18 14:11:33 +01:00
sfilippone da7a3be4e4 Fix AMG_prefix for some defines 2025-03-18 12:18:36 +01:00
sfilippone 0b9ca017c6 Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2025-03-17 17:53:12 +01:00
sfilippone 6fa5b04387 Change and use #define with PSB_ and AMG_ prefixes 2025-03-17 17:52:25 +01:00
Luca Pepè Sciarria 5748358fe9 add make install configuration 2025-03-17 12:23:09 +01:00
Salvatore Filippone 474f8e463e Update README.md 2025-03-12 14:29:00 +01:00
Salvatore Filippone ac7d7373e6 Update README.md 2025-03-12 11:14:28 +01:00
Luca Pepè Sciarria 20b3c30e24 add output directory for .a libraries 2025-03-03 15:10:29 +01:00
Salvatore Filippone f159f35eb2 Change Makefile for a better clean target 2025-03-02 11:18:48 +01:00
Salvatore Filippone 886d539ffc Change args to AR command 2025-03-02 11:18:07 +01:00
sfilippone 2910ac6537 Add names for Intel compilers ifx & friends 2025-03-01 12:49:35 +01:00
sfilippone 3b3a6c88a8 Silence more warnings/errors from INTEL 2025-03-01 12:48:52 +01:00
Luca Pepè Sciarria d61c9fed9f init cmake build system 2025-02-24 16:20:50 +01:00
Luca Pepè Sciarria a8cf53d80e Add cbind build and compilation through cmake 2025-02-24 16:19:26 +01:00
Luca Pepè Sciarria 2efe639a19 add compilation flag for IPK4 LPK8 and build of amgprec library 2025-02-24 14:05:35 +01:00
Luca Pepè Sciarria b426a9ccf7 remove impl/solver/amg_*_invk_solver_set* from compiling 2025-02-24 14:04:54 +01:00
Luca Pepè Sciarria 1feaf40972 remove impl/solver/amg_*_invt_solver_set* from compiling 2025-02-24 13:45:27 +01:00
Luca Pepè Sciarria cc66413be8 remove impl/solver/amg_*_ainv_solver_set* from compiling 2025-02-24 13:41:45 +01:00
sfilippone f6afacd1ff Update docs for allocate/deallocate _wrk 2025-02-24 09:57:14 +01:00
sfilippone 02bf24efa3 Fix version in configure 2025-02-24 09:17:37 +01:00
sfilippone f6349d34d1 Provide alias deallocate_wrk for free_wrk. Document and use. 2025-02-23 10:46:45 +01:00
sfilippone 2e79105695 Fix CUDA defines for compilation 2025-02-21 18:07:58 +01:00
sfilippone 921535c3c9 Update copyright 2025-02-21 16:41:39 +01:00
sfilippone 557809755e Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2025-02-21 16:36:10 +01:00
sfilippone 64105a17c5 Delete changelog 2025-02-21 16:35:45 +01:00
sfilippone 67c32da222 Update docs 2025-02-21 16:33:43 +01:00
Salvatore Filippone f317a571f4 Update README.md 2025-02-21 16:12:17 +01:00
sfilippone b075182ce6 Obsolete AINV_SOLVER_SETirc 2025-02-21 16:06:21 +01:00
sfilippone be469f8844 Added comments on allocat_wrk 2025-02-21 15:39:43 +01:00
Salvatore Filippone 04bcf04a9c Update README.md 2025-02-21 15:29:59 +01:00
sfilippone 725e39586d Fix TLU solver_bld and CUDA test program to print format. 2025-02-21 15:22:51 +01:00
sfilippone e68304e84f Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2025-02-21 15:06:09 +01:00
sfilippone 3972f27eb5 Rework cuda example 2025-02-21 15:05:35 +01:00
fdurastante b21e5aebab Update README.md 2025-02-21 14:33:39 +01:00
Cirdans-Home 6e2d61b51e Initial README for examples 2025-02-21 13:03:43 +00:00
sfilippone 4ee170f0ec Update version 1.2.0 2025-02-21 12:32:36 +01:00
sfilippone 4a9f8e9da0 Move newslv to samples and fix it 2025-02-21 12:32:04 +01:00
sfilippone 94caab8aa9 Removed make veryclean, introduced make distclean 2025-02-20 17:00:32 +01:00
sfilippone 749ab2f6ae Fix extprol. Remove obsolete hybrid aggregator. 2025-02-20 11:53:58 +01:00
sfilippone bf96dd554c Merge branch 'repackage' into development 2025-02-19 17:35:47 +01:00
Salvatore Filippone b5f5d356fd Missing CBIND clean target 2024-10-16 10:55:59 +02:00
1095 changed files with 271689 additions and 42686 deletions
+12
View File
@@ -0,0 +1,12 @@
$Format:%d%n%n$
# Fall back version, probably last release:
1.2.1
# AMG4PSBLAS version file.
#
# Release archive created from commit:
# $Format:%H %d$
# $Format:Created on %ci by %cN, and$
# $Format:signed by %GS using %GK.$
# $Format:Signature status: %G?$
$Format:%GG$
+28
View File
@@ -0,0 +1,28 @@
*.a export-ignore
*.o export-ignore
*.mod export-ignore
*.smod export-ignore
*~ export-ignore
.git* export-ignore
Make.inc export-ignore
config export-ignore
config/ export-ignore
config/** export-ignore
configure.ac export-ignore
config.log export-ignore
config.status export-ignore
aclocal.m4 export-ignore
autogen.sh export-ignore
autom4te.cache export-ignore
Dockerfile export-ignore
.travis.yml export-ignore
# generated folder
./include/** export-ignore
./modules/** export-ignore
docs/src export-ignore
docs/doxypsb export-ignore
docs/Makefile export-ignore
# the executable from tests
+1
View File
@@ -5,6 +5,7 @@
# header files generated # header files generated
cbind/*.h cbind/*.h
amgprec/amg_config.h
# Make.inc generated # Make.inc generated
/Make.inc /Make.inc
+546
View File
@@ -0,0 +1,546 @@
cmake_minimum_required(VERSION 3.10)
project(amg4psblas VERSION 1.0 LANGUAGES C CXX Fortran)
set(CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}/cmake")
set(PSBLAS_INSTALL_DIR "" CACHE PATH "Path to the PSBLAS installation
directory")
if(PSBLAS_INSTALL_DIR STREQUAL "")
message(FATAL_ERROR "Please specify the path to the PSBLAS installation directory using -DPSBLAS_INSTALL_DIR=<path> or set it in ccmake.")
endif()
# Check for the installation path for psblas
message(STATUS "psblas directory is ${PSBLAS_INSTALL_DIR};")
message(STATUS "PSBLAS DIRECTORY INC ${INCDIR}; MOD ${MODDIR}; LIB ${LIBDIR};")
#set(CMAKE_CXX_STANDARD 17) # Set cxx standard for the c++ part of the library
# Find the psblas package
find_package(psblas REQUIRED PATHS ${PSBLAS_INSTALL_DIR})
if(NOT psblas_FOUND)
message(FATAL_ERROR "PSBLAS not found!")
else()
message(STATUS "Found PSBLAS: ${PSBLAS_LIBRARIES}")
endif()
if(CMAKE_BUILD_TYPE STREQUAL "Debug")
# Add -g to the Fortran compiler flags.
# We use STRING(APPEND) to ensure we don't overwrite other important flags.
string(APPEND CMAKE_Fortran_FLAGS " -g")
string(APPEND CMAKE_CXX_FLAGS " -g")
message(STATUS "Fortran and CXX debug flags added: -g")
endif()
string(APPEND CMAKE_Fortran_FLAGS " -O2")
string(APPEND CMAKE_CXX_FLAGS " -O2")
message(STATUS "Fortran and CXX optimization flags added: -O2")
# Set the include and library directories based on the provided path
#set(TEST_INSTALLDIR "${PSBLAS_INSTALL_DIR}")
set(INCDIR "${PSBLAS_INSTALL_DIR}/${PSB_CMAKE_INSTALL_INCLUDEDIR}")
set(MODDIR "${PSBLAS_INSTALL_DIR}/${PSB_CMAKE_INSTALL_MODULDIR}")
set(LIBDIR "${PSBLAS_INSTALL_DIR}/${PSB_CMAKE_INSTALL_LIBDIR}")
# Include directories for the project
include_directories(${PSBLAS_INSTALL_DIR} ${MPI_INCLUDE_PATH} )
# Include directories for the Fortran compiler
include_directories(${INCDIR} ${MODDIR} ${LIBDIR})
message(STATUS "Using IPK size: ${PSB_IPK_SIZE}")
message(STATUS "Using LPK size: ${PSB_LPK_SIZE}")
# Add PSB_IPK/LPK flag only for fortran files.
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_IPK${PSB_IPK_SIZE}")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DPSB_LPK${PSB_LPK_SIZE}")
# Specify the installation directory
#set(${CMAKE_INSTALL_LIBDIR} "lib")
#message(STATUS "\t\t install libdir ${CMAKE_INSTALL_LIBDIR};")
#set(CMAKE_RUNTIME_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_BINDIR}/${${CMAKE_PROJECT_NAME}_dist_string}-tests")
#set(CMAKE_LIBRARY_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_LIBDIR}")
#set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_LIBDIR}")
set(CMAKE_RUNTIME_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_BINDIR}/${${CMAKE_PROJECT_NAME}_dist_string}-tests")
set(CMAKE_LIBRARY_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}")
set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY "${CMAKE_BINARY_DIR}")
#set(CMAKE_INSTALL_LIBDIR "lib" CACHE STRING "Library install directory")
#set(CMAKE_INSTALL_INCLUDEDIR "include" CACHE STRING "Include directory")
#set(CMAKE_INSTALL_MODULDIR "modules" CACHE STRING "Module directory")
message(STATUS "Initial CMAKE_INSTALL_LIBDIR: ${CMAKE_INSTALL_LIBDIR}")
set(AMG_CMAKE_INSTALL_PREFIX ${CMAKE_INSTALL_PREFIX})
if(NOT AMG_CMAKE_INSTALL_LIBDIR)
message(STATUS "CMAKE_INSTALL_LIBDIR is set to default value lib")
#set(CMAKE_INSTALL_LIBDIR "lib" CACHE STRING "Library install directory" FORCE)
set(CMAKE_INSTALL_LIBDIR ${PSB_CMAKE_INSTALL_LIBDIR})
set(AMG_CMAKE_INSTALL_LIBDIR ${PSB_CMAKE_INSTALL_LIBDIR})
else()
set(CMAKE_INSTALL_LIBDIR ${AMG_CMAKE_INSTALL_LIBDIR})
message(STATUS "CMAKE_INSTALL_LIBDIR is set to: ${CMAKE_INSTALL_LIBDIR}")
endif()
if(NOT AMG_CMAKE_INSTALL_INCLUDEDIR)
message(STATUS "CMAKE_INSTALL_INCLUDEDIR is set to default value lib")
#set(CMAKE_INSTALL_INCLUDEDIR "include" CACHE STRING "Include directory" FORCE)
set(CMAKE_INSTALL_INCLUDEDIR ${PSB_CMAKE_INSTALL_INCLUDEDIR})
set(AMG_CMAKE_INSTALL_INCLUDEDIR ${PSB_CMAKE_INSTALL_INCLUDEDIR})
else()
set(CMAKE_INSTALL_INCLUDEDIR ${AMG_CMAKE_INSTALL_INCLUDEDIR})
message(STATUS "CMAKE_INSTALL_INCLUDEDIR is set to: ${CMAKE_INSTALL_INCLUDEDIR}")
endif()
if(NOT AMG_CMAKE_INSTALL_MODULDIR)
message(STATUS "CMAKE_INSTALL_MODULDIR is set to default value lib")
#set(CMAKE_INSTALL_MODULDIR "modules" CACHE STRING "Modules directory" FORCE)
set(CMAKE_INSTALL_MODULDIR ${PSB_CMAKE_INSTALL_MODULDIR})
set(AMG_CMAKE_INSTALL_LIBDIR ${PSB_CMAKE_INSTALL_MODULDIR})
else()
set(CMAKE_INSTALL_MODULDIR ${AMG_CMAKE_INSTALL_MODULDIR})
message(STATUS "CMAKE_INSTALL_MODULDIR is set to: ${CMAKE_INSTALL_MODULDIR}")
endif()
#-----------------------------------------------------
# Publicize installed location to other CMake projects
#-----------------------------------------------------
#install(EXPORT ${CMAKE_PROJECT_NAME}-targets
# DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake"
#)
message(STATUS "NAME project ${CMAKE_PROJECT_NAME};")
install(EXPORT ${CMAKE_PROJECT_NAME}-targets
FILE ${CMAKE_PROJECT_NAME}Config.cmake
NAMESPACE ${CMAKE_PROJECT_NAME}::
DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake"
)
include(CMakePackageConfigHelpers) # standard CMake module
write_basic_package_version_file(
"${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_PROJECT_NAME}ConfigVersion.cmake"
VERSION "${amg4psblas_VERSION}"
COMPATIBILITY SameMajorVersion
)
configure_file("${CMAKE_SOURCE_DIR}/cmake/${CMAKE_PROJECT_NAME}Config.cmake.in"
"${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/${CMAKE_PROJECT_NAME}Config.cmake" @ONLY)
install(
FILES
"${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/${CMAKE_PROJECT_NAME}Config.cmake"
"${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_PROJECT_NAME}ConfigVersion.cmake"
"${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_PROJECT_NAME}Targets.cmake"
DESTINATION
"${CMAKE_INSTALL_LIBDIR}/cmake/${CMAKE_PROJECT_NAME}"
)
#------------------------------------------
# Add portable unistall command to makefile
#------------------------------------------
# Adapted from the CMake Wiki FAQ
configure_file ( "${CMAKE_SOURCE_DIR}/cmake/uninstall.cmake.in" "${CMAKE_BINARY_DIR}/uninstall.cmake"
@ONLY)
add_custom_target ( uninstall
COMMAND ${CMAKE_COMMAND} -P "${CMAKE_BINARY_DIR}/uninstall.cmake" )
add_custom_target(check COMMAND ${CMAKE_CTEST_COMMAND} --output-on-failure)
# See JSON-Fortran's CMakeLists.txt file to find out how to get the check target to depend
# on the test executables
#----------------------------------
# Determine if we're using Open MPI
#---------------------------------
find_package( MPI REQUIRED Fortran C CXX )
if(MPI_FOUND)
#-----------------------------------------------
# Work around an issue present on fedora systems
#-----------------------------------------------
if( (MPI_CXX_LINK_FLAGS MATCHES "noexecstack") OR (MPI_Fortran_LINK_FLAGS MATCHES "noexecstack") )
message ( WARNING
"The `noexecstack` linker flag was found in the MPI_<lang>_LINK_FLAGS variable. This is
known to cause segmentation faults for some Fortran codes. See, e.g.,
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=71729 or
https://github.com/sourceryinstitute/OpenCoarrays/issues/317.
`noexecstack` is being replaced with `execstack`"
)
string(REPLACE "noexecstack"
"execstack" MPI_CXX_LINK_FLAGS_FIXED ${MPI_CXX_LINK_FLAGS})
string(REPLACE "noexecstack"
"execstack" MPI_C_LINK_FLAGS_FIXED ${MPI_C_LINK_FLAGS})
string(REPLACE "noexecstack"
"execstack" MPI_Fortran_LINK_FLAGS_FIXED ${MPI_Fortran_LINK_FLAGS})
set(MPI_CXX_LINK_FLAGS "${MPI_CXX_LINK_FLAGS_FIXED}" CACHE STRING
"MPI CXX linking flags" FORCE)
set(MPI_C_LINK_FLAGS "${MPI_C_LINK_FLAGS_FIXED}" CACHE STRING
"MPI C linking flags" FORCE)
set(MPI_Fortran_LINK_FLAGS "${MPI_Fortran_LINK_FLAGS_FIXED}" CACHE STRING
"MPI Fortran linking flags" FORCE)
endif()
message(STATUS "Found MPI: ${MPI_C_LIBRARIES} - ${MPI_CXX_LIBRARIES} - ${MPI_Fortran_LIBRARIES}")
#----------------
# Setup MPI compilers
#----------------
set(CMAKE_C_COMPILER ${MPI_C_COMPILER} CACHE FILEPATH "C compiler" FORCE)
set(CMAKE_CXX_COMPILER ${MPI_CXX_COMPILER} CACHE FILEPATH "C++ compiler" FORCE)
set(CMAKE_Fortran_COMPILER ${MPI_Fortran_COMPILER} CACHE FILEPATH "Fortran compiler" FORCE)
#----------------
# Setup MPI flags
#----------------
list(REMOVE_DUPLICATES MPI_Fortran_INCLUDE_PATH)
set(CMAKE_C_COMPILE_FLAGS ${CMAKE_C_COMPILE_FLAGS} ${MPI_C_COMPILE_FLAGS})
set(CMAKE_C_LINK_FLAGS ${CMAKE_C_LINK_FLAGS} ${MPI_C_LINK_FLAGS})
set(CMAKE_CXX_COMPILE_FLAGS ${CMAKE_CXX_COMPILE_FLAGS} ${MPI_CXX_COMPILE_FLAGS})
set(CMAKE_CXX_LINK_FLAGS ${CMAKE_CXX_LINK_FLAGS} ${MPI_CXX_LINK_FLAGS})
set(CMAKE_Fortran_COMPILE_FLAGS ${CMAKE_Fortran_COMPILE_FLAGS} ${MPI_Fortran_COMPILE_FLAGS})
set(CMAKE_Fortran_LINK_FLAGS ${CMAKE_Fortran_LINK_FLAGS} ${MPI_Fortran_LINK_FLAGS})
include_directories(BEFORE ${MPI_C_INCLUDE_PATH} ${MPI_CXX_INCLUDE_PATH} ${MPI_Fortran_INCLUDE_PATH})
message(STATUS "${MPI_C_INCLUDE_PATH}; ${MPI_Fortran_INCLUDE_PATH};; ${CMAKE_Fortran_LINK_FLAGS} ;")
if(MPI_Fortran_HAVE_F90_MODULE OR MPI_Fortran_HAVE_F08_MODULE)
add_compile_options(-DPSB_MPI_MOD)
message(STATUS "-DPSB_MPI_MOD")
#add_compile_options(-DSERIAL_MPI) # Is it right??
#message(STATUS "-DSERIAL_MPI")
endif()
set(PSB_SERIAL_MPI OFF)
else()
message(STATUS "MPI not found, serial ahead")
add_compile_options(-DPSB_SERIAL_MPI)
add_compile_options(-DPSB_MPI_MOD)
set(PSB_SERIAL_MPI ON)
set(CSERIALMPI "#define PSB_SERIAL_MPI")
endif()
add_compile_options(-O3)
add_compile_options($<$<COMPILE_LANGUAGE:Fortran>:-frecursive>)
if(MPI_FOUND)
execute_process(COMMAND ${MPIEXEC} --version
OUTPUT_VARIABLE mpi_version_out)
if (mpi_version_out MATCHES "[Oo]pen[ -][Mm][Pp][Ii]")
message( STATUS "OpenMPI detected")
set ( openmpi true )
endif()
set(MPI_H_COPIED FALSE)
set(MPI_INCLUDE_DIR "${CMAKE_CURRENT_BINARY_DIR}/include") # Define the include directory
# Create the include directory if it doesn't exist
file(MAKE_DIRECTORY "${MPI_INCLUDE_DIR}")
foreach(path IN LISTS MPI_INCLUDE_PATH)
# Construct the full path to the mpi.h file
set(mpi_h_path "${path}/mpi.h")
# Check if the mpi.h file exists
if(EXISTS "${mpi_h_path}")
# Copy the mpi.h file to the include directory
file(COPY "${mpi_h_path}" DESTINATION "${MPI_INCLUDE_DIR}")
message(STATUS "Copied mpi.h from ${mpi_h_path} to ${MPI_INCLUDE_DIR}")
set(MPI_H_COPIED TRUE)
break() # Exit the loop once we've copied the file
endif()
endforeach()
if(NOT MPI_H_COPIED)
message(WARNING "mpi.h not found in any of the specified paths: ${MPI_INCLUDE_PATH}")
endif()
# Add the created include directory to the project's include directories
#include_directories("${MPI_INCLUDE_DIR}")
endif()
# Find AMG constants
include(${CMAKE_CURRENT_LIST_DIR}/cmake/readAMGConst.cmake)
_amg_read_const()
if ("${PSB_LPK_SIZE}" EQUAL 8)
set(CXXMATCHBOXBIT "#define AMG_MATCHBOXP_BIT64")
endif()
#------------------------------------------
# Configure the amg_config.h file
#------------------------------------------
message(STATUS "bin dir ${CMAKE_CURRENT_BINARY_DIR}; source dir ${CMAKE_CURRENT_SOURCE_DIR};;")
configure_file(
${CMAKE_CURRENT_SOURCE_DIR}/amgprec/amg_config.h.in
${CMAKE_CURRENT_BINARY_DIR}/include/amg_config.h
@ONLY # Replace variables only
)
#---------------------------------------
# Add the AMG libraries
#---------------------------------------
# In your CMakeLists.txt
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-256")
message(STATUS "MPI_LIBRARIES: ${MPI_LIBRARIES}")
message(STATUS "MPI_CXX_LIBRARIES: ${MPI_CXX_LIBRARIES}")
include(${CMAKE_CURRENT_LIST_DIR}/amgprec/CMakeLists.txt) # include amgprec_source_files and amgprec_source_C_files source files
include_directories("${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_INCLUDEDIR}")
add_library(amgprec_C OBJECT ${amgprec_source_C_files})
add_library(amgprec_CPP OBJECT ${amgprec_source_CPP_files})
target_link_libraries(amgprec_C
#PUBLIC ${LAPACK_LINKER_FLAGS} ${LAPACK_LIBRARIES} ${LAPACK95_LIBRARIES}
#PUBLIC ${BLAS_LINKER_FLAGS} ${BLAS_LIBRARIES} ${BLAS95_LIBRARIES}
psblas::util psblas::linsolve psblas::prec psblas::ext psblas::cbind psblas::base
#${MPI_C_LIBRARIES}
) #TODO check actual libraries needed
target_link_libraries(amgprec_CPP
#PUBLIC ${LAPACK_LINKER_FLAGS} ${LAPACK_LIBRARIES} ${LAPACK95_LIBRARIES}
#PUBLIC ${BLAS_LINKER_FLAGS} ${BLAS_LIBRARIES} ${BLAS95_LIBRARIES}
psblas::util psblas::linsolve psblas::prec psblas::ext psblas::cbind psblas::base
stdc++
${MPI_CXX_LIBRARIES}) #TODO check actual libraries needed
add_library(amgprec ${amgprec_source_files} $<TARGET_OBJECTS:amgprec_CPP> $<TARGET_OBJECTS:amgprec_C> )
set_target_properties(amgprec
PROPERTIES
Fortran_MODULE_DIRECTORY "${CMAKE_BINARY_DIR}/modules"
POSITION_INDEPENDENT_CODE TRUE
OUTPUT_NAME amg_prec
LINKER_LANGUAGE Fortran
)
target_include_directories(amgprec PUBLIC
$<BUILD_INTERFACE:${CMAKE_BINARY_DIR}/modules>
$<INSTALL_INTERFACE:modules>)
message(STATUS "include dir := ${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_INCLUDEDIR}")
#target_include_directories(base PUBLIC ${CMAKE_Fortran_MODULE_DIRECTORY})
target_include_directories(amgprec PUBLIC ${INCDIR} ${MODDIR})
target_link_libraries(amgprec
#PUBLIC ${LAPACK_LINKER_FLAGS} ${LAPACK_LIBRARIES} ${LAPACK95_LIBRARIES}
#PUBLIC ${BLAS_LINKER_FLAGS} ${BLAS_LIBRARIES} ${BLAS95_LIBRARIES}
psblas::util psblas::linsolve psblas::prec psblas::ext psblas::cbind psblas::base
#${MPI_Fortran_LIBRARIES} ${MPI_CXX_LIBRARIES} ${MPI_C_LIBRARIES}
) #TODO check actual libraries needed
include(${CMAKE_CURRENT_LIST_DIR}/cbind/CMakeLists.txt) # include amgprec_source_files and amgprec_source_C_files source files
foreach(path IN LISTS amgcbind_header_C_files)
# Copy the header file to the include directory
file(COPY "${path}" DESTINATION "${CMAKE_BINARY_DIR}/include")
endforeach()
add_library(amgcbind_C OBJECT ${amgcbind_source_C_files})
target_link_libraries(amgcbind_C
#PUBLIC ${LAPACK_LINKER_FLAGS} ${LAPACK_LIBRARIES} ${LAPACK95_LIBRARIES}
#PUBLIC ${BLAS_LINKER_FLAGS} ${BLAS_LIBRARIES} ${BLAS95_LIBRARIES}
psblas::util psblas::linsolve psblas::prec psblas::ext psblas::cbind psblas::base) #TODO check actual libraries needed
add_library(amgcbind ${amgcbind_source_files} $<TARGET_OBJECTS:amgcbind_C>)
set_target_properties(amgcbind
PROPERTIES
Fortran_MODULE_DIRECTORY "${CMAKE_BINARY_DIR}/modules"
POSITION_INDEPENDENT_CODE TRUE
OUTPUT_NAME amg_cbind
LINKER_LANGUAGE Fortran
)
target_include_directories(amgcbind PUBLIC
$<BUILD_INTERFACE:${CMAKE_BINARY_DIR}/modules>
$<INSTALL_INTERFACE:modules>)
message(STATUS "include dir := ${CMAKE_BINARY_DIR}/${CMAKE_INSTALL_INCLUDEDIR}")
#target_include_directories(base PUBLIC ${CMAKE_Fortran_MODULE_DIRECTORY})
target_include_directories(amgcbind PUBLIC ${INCDIR} ${MODDIR})
target_link_libraries(amgcbind
#PUBLIC ${LAPACK_LINKER_FLAGS} ${LAPACK_LIBRARIES} ${LAPACK95_LIBRARIES}
#PUBLIC ${BLAS_LINKER_FLAGS} ${BLAS_LIBRARIES} ${BLAS95_LIBRARIES}
PUBLIC amgprec psblas::util psblas::linsolve psblas::prec
psblas::ext psblas::cbind psblas::base)
#TODO check actual libraries needed
install(DIRECTORY ${CMAKE_BINARY_DIR}/include/ DESTINATION "${CMAKE_INSTALL_INCLUDEDIR}"
FILES_MATCHING PATTERN "*.h")
install(DIRECTORY ${CMAKE_BINARY_DIR}/modules/ DESTINATION "${CMAKE_INSTALL_MODULDIR}"
FILES_MATCHING PATTERN "*.mod")
# Install the library
install(TARGETS amgprec amgcbind
EXPORT ${CMAKE_PROJECT_NAME}-targets
DESTINATION "${CMAKE_INSTALL_LIBDIR}"
LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}"
)
if(WIN32) #TODO
# install(TARGETS psb_base_C
# EXPORT ${CMAKE_PROJECT_NAME}-targets
# DESTINATION "${CMAKE_INSTALL_LIBDIR}"
# LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}"
# )
# if(METIS_FOUND)
# install(TARGETS psb_util_C
# EXPORT ${CMAKE_PROJECT_NAME}-targets
# DESTINATION "${CMAKE_INSTALL_LIBDIR}"
# LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}"
# )
# endif()
endif()
message(STATUS "install directory is ${CMAKE_INSTALL_LIBDIR};;;")
# Step 2: Create the configuration file from the template
#configure_package_config_file(
# "${CMAKE_CURRENT_SOURCE_DIR}/cmake/amg4psblasConfig.cmake.in"
# "${CMAKE_CURRENT_BINARY_DIR}/amg4psblasConfig.cmake"
# INSTALL_DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/amg4psblas"
#)
# Step 3: Install the generated config files
#install(FILES
# "${CMAKE_CURRENT_BINARY_DIR}/amg4psblasConfig.cmake"
# "${CMAKE_CURRENT_BINARY_DIR}/amg4psblasConfigVersion.cmake"
# DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/amg4psblas"
#)
# Step 4: Export targets so that the build directory can be used directly
#export(
# EXPORT ${CMAKE_PROJECT_NAME}-targets
# FILE "${CMAKE_CURRENT_BINARY_DIR}/amg4psblasTargets.cmake"
# NAMESPACE psblas::
#)
export(
EXPORT ${CMAKE_PROJECT_NAME}-targets
FILE "${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_PROJECT_NAME}Targets.cmake"
NAMESPACE ${CMAKE_PROJECT_NAME}::
)
#export(
# EXPORT ${CMAKE_PROJECT_NAME}-targets
# FILE "${CMAKE_CURRENT_BINARY_DIR}/${CMAKE_PROJECT_NAME}Targets.cmake"
# NAMESPACE ${CMAKE_PROJECT_NAME}::
#)
# Set the installation directory for the test files
set(INSTALL_TEST_DIR "${CMAKE_INSTALL_PREFIX}/samples" CACHE PATH "Installation directory for sample files")
function(install_directory_recursive source_dir install_base_dir) # Function to install a directory and its subdirectories recursively
file(GLOB_RECURSE ALL_FILES RELATIVE "${CMAKE_CURRENT_SOURCE_DIR}/${source_dir}" "${source_dir}/*")
foreach(FILE_PATH IN LISTS ALL_FILES)
# Construct the full source and destination paths
set(FULL_SOURCE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/${source_dir}/${FILE_PATH}")
set(FULL_INSTALL_PATH "${install_base_dir}/${FILE_PATH}")
# Check if it's a directory
if(IS_DIRECTORY "${FULL_SOURCE_PATH}")
# Create the directory in the install destination
file(MAKE_DIRECTORY "${FULL_INSTALL_PATH}")
else()
# Install the file
install(FILES "${FULL_SOURCE_PATH}" DESTINATION "${install_base_dir}" RENAME "${FILE_PATH}")
endif()
endforeach()
endfunction()
# Install test/fileread directory
install_directory_recursive(samples/simple "${INSTALL_TEST_DIR}/simple")
# Install test/pdegen directory
install_directory_recursive(samples/advanced "${INSTALL_TEST_DIR}/advanced")
message(STATUS "CMAKE_INSTALL_PREFIX: ${CMAKE_INSTALL_PREFIX} - ${PSB_CMAKE_INSTALL_PREFIX};")
message(STATUS "CMAKE_INSTALL_LIBDIR: ${CMAKE_INSTALL_LIBDIR} - ${PSB_CMAKE_INSTALL_LIBDIR};")
message(STATUS "CMAKE_INSTALL_INCLUDEDIR: ${CMAKE_INSTALL_INCLUDEDIR} - ${PSB_CMAKE_INSTALL_INCLUDEDIR};")
message(STATUS "CMAKE_INSTALL_MODULDIR: ${CMAKE_INSTALL_MODULDIR} - ${PSB_CMAKE_INSTALL_MODULDIR};")
-165
View File
@@ -1,165 +0,0 @@
Changelog. A lot less detailed than usual, at least for past
history.
2022/05/20: Restart ChangeLog. Updated to new name AMG4PSBLAS, now using PSB3.8
2018/10/28: Fix interface to MUMPS and configry machinery. Require PSB 3.6.
2018/10/10: ICTXT argument in prec%init().
2018/07/30: Fixes for Intel compilers. BootCMatch interface in examples.
2018/05/14: Interface for extension of aggregation methods.
2018/02/28: New cartesian distribution for sample programs.
2017/12/15: New WRK component of preconditioner levels, preallocation.
2017/10/25: New example input file formats. Added sample matrices.
2017/10/02: New CBIND in PSBLAS 3.5.0
2017/07/30: Refactored examples. Change default thresholds.
2017/05/31: New internal description of ML.
2017/05/16: Improve build process.
2017/04/20: Force %set interface. Update docs.
2017/04/03: Remove obsolete stuff.
2017/03/17: Fixed level%cnv; add coarse _solver tracker.
2017/02/18: Take out clean_zeros; changed NOFILTER; defined FBGS; take out
n_prec_levs.
2017/02/12: Updated mat_dist usage, dubious SP shell for UMFPACK, fixes
for RPM packaging.
2017/02/02: Fix superlu configury
2016/11/12: Fix hierarchy/smoothers build to handle 1 level.
2016/10/03: Merged changes to hierearchy building.
2016/08/20: Reimplemented decoupled aggregation
2016/07/20: Refactored application of multilevel. Defined V,W and
K-cycles.
2016/05/18: Reworked internals of PRECSET. Defined Forward-Backward
Gauss-Seidel solver. Now available separate PRE and POST smoother
objects.
2016/03/30: MUMPS interface.
2016/02/28: Hybrid Gauss-Seidel method.
2016/02/03: unify integer argument checks.
2015/12/15: defaults single vs. double precision. Use clean_zeros.
2015/12/08: new matdist interface
2015/10/17: configry fixes
2015/10/13: Fixes for SLUDIST versions 3 and 4
2015/05/03: New heap interface
2015/04/21: INTENT fixes
2014/12/21: New error handling
2014/10/27: Added versioncheck to configure.
2014/03/31: New get_diag.
2013/11/07: Merged changes from experimental branch. Fix INCDIR in
makefiles.
2013/07/15: Fixes for UMFPACK 5.4, SuperLU 4.3, SuperLU_Dist 3.3
2013/04/05: CLONE method.
2013/03/08: Reworked SET routines.
2012/12/10: Enable long_integers.
2012/12/05: Split smoother/solver objects.
2012/04/30: New scheme to find dynamically the number of level based on
the size of the coarse matrix
2012/01/10: Done split interface/implementation, plus subdir restructure.
2011/12/13: Start split interface/implementation to improve build time.
2011/11/25: Now works with _vect methods from PSBLAS.
2011/10/24: New test generation methods.
2011/06/15: Dump prolongator/restrictor
2011/04/14: Added MOLD argument(s) to precbld.
2011/03/30: Fixed: descriptive methods, example programs.
2011/03/08: Re-factored modules for ILU methods.
2011/03/04: Make X intent(inout) in APPLY to allow for preconditioners
using SPMM.
2011/03/02: New set methods.
2011/01/07: Fixed UMF interfacing for Z data.
2011/01/04: Added UMF inteface for D data.
2011/01/02: Fix usage of DESC_DATA. Switched all names to F90 ending.
2010/12/16: Fix usage of replicated space descriptor.
2010/11/16: Fix Jacobi smoother in case of empty off-diagonal.
2010/11/04: Defined and tested single real and complex.
2010/11/02: Aligned usage of sparse data type with psblas3.
2009/12/22: Aligned constants with mld2p4 v1.2
2009/12/11: First working version of double multilevel.
2009/12/05: Inttroduction of Smoother/Solver object hierarchy.
2009/09/23: Initial F2003 version.
2009/01/28: Changed names from XbaseprcY to XbaseprecY.
2009/01/27: Changed names from mld_transfer to mld_move_alloc.
2009/01/13: Repackaged the one-level preconditioners. Reorganized the
build routines, taking out mlprec_bld, and switching the
number of levels when needed.
2008/10/27: Changed the definition of prec_type: repackaged with a
onelev-prec-type, containing a baseprec and maps between
index spaces. No performance impact; no changes to
user-level interfaces.
2008/09/18: Changed mld_sizeof to integer(8); updated samples.
2008/08/26: Fixed matrix generation in sample programs.
2008/07/25: missing implicit none in mld_prec_type.
2008/07/23: added HTML documentation
2008/06/13: Fixed aggregation for replicated index spaces.
2008/06/02: Threshold into decoupled aggregation algorithm.
2008/05/27: Single precision version.
2008/03/09: Introduced configure script.
2008/02/08: Merged changes from intermesh branch: we now have an
inter_desc_type object. Cleaned up data allocation and
variable initialization in multilevel prec application.
2008/01/10: Merged various fixes for: prologues, unused variables,
interface details.
2007/12/21: Merge version with prologues and internal docs.
2007/11/15: Created pargen example.
2007/11/14: Fix INTENT(IN) on X vector in preconditioner routines.
2007/10/19: Merged in ILU(P,T). To be tested extensively.
2007/10/17: Merged ILU(K) into trunk.
2007/10/16: Fixed ILU(K), it now performs satisfactorily. Also updated
ILU(0) to be more legible.
2007/10/11: First working version of ILU(K). Still slow, there should
be room for improvement.
2007/10/09: Added benchmark code.
2007/10/09: Added MILU_N_. Beware: values for UMF_ etc. have been
shifted.
2007/10/02: To do: decide whether to name MLD_KRYLOV_MOD or
PSB_KRYLOV_MOD.
2007/10/01: Start of this changelog. MLD2P4 now has a different
structure, to enable a build not embedded in PSBLAS.
+7 -9
View File
@@ -1,15 +1,13 @@
AMG4PSBLAS version 1.1 AMG4PSBLAS version 1.2
Algebraic Multigrid Package Algebraic Multigrid Package
based on PSBLAS (Parallel Sparse BLAS version 3.8) based on PSBLAS (Parallel Sparse BLAS version 3.9)
(C) Copyright 2025 Salvatore Filippone
(C) Copyright 2025 Pasqua D'Ambra
(C) Copyright 2025 Fabio Durastante
(C) Copyright 2022
Salvatore Filippone
Pasqua D'Ambra
Fabio Durastante
Redistribution and use in source and binary forms, with or without Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions modification, are permitted provided that the following conditions
are met: are met:
@@ -20,7 +18,7 @@
documentation and/or other materials provided with the distribution. documentation and/or other materials provided with the distribution.
3. The name of the AMG4PSBLAS group or the names of its contributors may 3. The name of the AMG4PSBLAS group or the names of its contributors may
not be used to endorse or promote products derived from this not be used to endorse or promote products derived from this
software without specific written permission. software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -1
View File
@@ -70,7 +70,8 @@ EXTRALIBS=@EXTRA_LIBS@
# #
AMGCDEFINES=$(MUMPSFLAGS) $(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS) $(PSBCDEFINES) AMGCDEFINES=$(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS)
#$(PSBCDEFINES) $(MUMPSFLAGS)
CDEFINES=$(AMGCDEFINES) CDEFINES=$(AMGCDEFINES)
AMGFDEFINES=@AMGFDEFINES@ $(PSBFDEFINES) AMGFDEFINES=@AMGFDEFINES@ $(PSBFDEFINES)
FDEFINES=$(AMGFDEFINES) FDEFINES=$(AMGFDEFINES)
+15 -13
View File
@@ -1,10 +1,11 @@
include Make.inc include Make.inc
all: objs lib all: mods objs lib
objs: libdir amgp cbnd
objs: libdir mods amgobjs cbnd
mods: libdir
cd amgprec && $(MAKE) mods
lib: objs lib: objs
cd amgprec && $(MAKE) lib cd amgprec && $(MAKE) lib
cd cbind && $(MAKE) lib cd cbind && $(MAKE) lib
@@ -15,13 +16,13 @@ libdir:
(if test ! -d modules ; then mkdir modules; fi;) (if test ! -d modules ; then mkdir modules; fi;)
($(INSTALL_DATA) Make.inc include/Make.inc.amg4psblas) ($(INSTALL_DATA) Make.inc include/Make.inc.amg4psblas)
amgobjs: mods
amgp:
cd amgprec && $(MAKE) objs cd amgprec && $(MAKE) objs
cbnd: amgp
cbnd: amgobjs
cd cbind && $(MAKE) objs cd cbind && $(MAKE) objs
install: lib install: all
mkdir -p $(INSTALL_LIBDIR) &&\ mkdir -p $(INSTALL_LIBDIR) &&\
$(INSTALL_DATA) lib/*.a $(INSTALL_LIBDIR) $(INSTALL_DATA) lib/*.a $(INSTALL_LIBDIR)
mkdir -p $(INSTALL_INCLUDEDIR) &&\ mkdir -p $(INSTALL_INCLUDEDIR) &&\
@@ -44,9 +45,10 @@ cleanlib:
(cd include; /bin/rm -f *.a *$(.mod) *$(.fh)) (cd include; /bin/rm -f *.a *$(.mod) *$(.fh))
(cd modules; /bin/rm -f *.a *$(.mod) *$(.fh)) (cd modules; /bin/rm -f *.a *$(.mod) *$(.fh))
veryclean: cleanlib distclean: clean samplesclean
(cd amgprec && $(MAKE) veryclean) /bin/rm -fr Make.inc amgprec/amg_config.h
(cd cbind && $(MAKE) veryclean)
samplesclean: clean
(cd samples/simple/fileread && $(MAKE) clean) (cd samples/simple/fileread && $(MAKE) clean)
(cd samples/simple/pdegen && $(MAKE) clean) (cd samples/simple/pdegen && $(MAKE) clean)
(cd samples/advanced/fileread && $(MAKE) clean) (cd samples/advanced/fileread && $(MAKE) clean)
@@ -55,6 +57,6 @@ veryclean: cleanlib
check: all check: all
make check -C samples/advanced/pdegen make check -C samples/advanced/pdegen
clean: clean: cleanlib
(cd amgprec && $(MAKE) clean) (cd amgprec && $(MAKE) veryclean)
(cd cbind && $(MAKE) clean) (cd cbind && $(MAKE) veryclean)
+105 -15
View File
@@ -1,19 +1,36 @@
# AMG4PSBLAS v1.2 # AMG4PSBLAS v1.2
Algebraic Multigrid Package based on [PSBLAS](https://github.com/sfilippone/psblas3) (Parallel Sparse BLAS version 3.9) Algebraic Multigrid Package based on [PSBLAS](https://github.com/sfilippone/psblas3) (Parallel Sparse BLAS version 3.9)
AMG4PSBLAS is a package of parallel algebraic multilevel preconditioners included in the PSCToolkit (Parallel Sparse Computation Toolkit) software framework. AMG4PSBLAS is a package of parallel algebraic multilevel preconditioners included in
the PSCToolkit (Parallel Sparse Computation Toolkit) software framework.
It is a progress of a software development project started in 2007, named MLD2P4, which originally implemented a multilevel version of some domain decomposition preconditioners of additive-Schwarz type and was based on a parallel decoupled version of the well known smoothed aggregation method to generate the multilevel hierarchy of coarser matrices. It is the prosecution of a software development project called MLD2P4 that started in 2007,
which originally implemented a multilevel version of some domain decomposition preconditioners
of additive-Schwarz type and was based on a parallel decoupled version of the well known
smoothed aggregation method to generate the multilevel hierarchy of coarser matrices.
In the last years the package was extended for including new algorithms and functionalities for the setup and application new AMG preconditioners with the final aims of improving efficiency and scalability when tens of thousands cores are used and of boosting reliability in dealing with general symmetric positive definite linear systems. In the last few years the package was extended by including new algorithms and functionalities
for the setup and application new AMG preconditioners with the final goal of improving efficiency
and scalability when using tens of thousands cores and boosting reliability in dealing
with general symmetric positive definite linear systems.
It is an evolution of MLD2P4 (see [LICENSE.MLD2P4](LICENSE.MLD2P4)), but due to the significant number of changes and the increase in scope, we decided to rename the package as AMG4PSBLAS. The original license is shown in the file [LICENSE.MLD2P4](LICENSE.MLD2P4); due to the
significant number of changes and the vast enlargement in scope, we decided to rename
the package as AMG4PSBLAS.
AMG4PSBLAS has been designed to provide scalable and easy-to-use preconditioners in the context of the PSBLAS (Parallel Sparse Basic Linear Algebra Subprograms) computational framework and can be used in conjuction with the Krylov solvers available in this framework. Our package is based on a completely algebraic approach; therefore users level interfaces assume that the system matrix and preconditioners are represented as PSBLAS distributed sparse matrices. AMG4PSBLAS has been designed to provide scalable and easy-to-use preconditioners in the context
of the PSBLAS (Parallel Sparse Basic Linear Algebra Subprograms) computational framework and can be
used in conjuction with the Krylov solvers available in this framework. Our package is based on
a completely algebraic approach; therefore users level interfaces assume that the system matrix
and preconditioners are represented as PSBLAS distributed sparse matrices.
AMG4PSBLAS enables the user to easily specify different features of an algebraic multilevel preconditioner, thus allowing to experiment with different preconditioners for the problem and parallel computers at hand. AMG4PSBLAS enables the user to easily specify different features of an algebraic multilevel preconditioner,
thus allowing to experiment with different preconditioners for the problem and parallel computers at hand.
The package employs object-oriented design techniques in Fortran 2008, with interfaces to additional third party libraries such as MUMPS, UMFPACK, SuperLU, and SuperLU_Dist, which can be exploited in building multilevel preconditioners. The parallel implementation is based on a Single Program Multiple Data (SPMD) paradigm; the inter-process communication is based on MPI and is managed mainly through PSBLAS. The package employs object-oriented design techniques in Fortran 2008, with interfaces to additional third
party libraries such as MUMPS, UMFPACK, SuperLU, and SuperLU_Dist, which can be exploited in building
multilevel preconditioners. The parallel implementation is based on a Single Program Multiple Data (SPMD)
paradigm; the inter-process communication is based on MPI and is managed mainly through PSBLAS.
## Main Refrerences: ## Main Refrerences:
@@ -32,20 +49,23 @@ The main reference for features inherited from MLD2P4 is
## Installing ## Installing
Installation requires having a working version of the [PSBLAS](https://github.com/sfilippone/psblas3) library installed. Installation requires a working version of the [PSBLAS](https://github.com/sfilippone/psblas3) library
AMG4PSBLAS has several interfaces to third-party libraries that can be used in the construction and application phases of preconditioners. as a prerequisite.
In particular, it is possible to link AMG4PSBLAS with the libraries: MUMPS, SuperLU, SuperLU_Dist, UMFPACK. This is _not mandatory_ and the library can run AMG4PSBLAS has several interfaces to third-party libraries that can be used in the construction
and application phases of preconditioners;
in particular, it is possible to link AMG4PSBLAS with the libraries: MUMPS, SuperLU, SuperLU_Dist, UMFPACK.
The usage of these third party libraries is _not mandatory_: the package can function
in isolation and without these features. in isolation and without these features.
0. Unpack the tar file in a directory of your choice (preferrably 0. Unpack the tar file in a directory of your choice (preferrably
outside the main PSBLAS directory). outside the main PSBLAS directory).
1. run configure `--with-psblas=<ABSOLUTE path of the PSBLAS install directory>` 1. run configure `--with-psblas=<ABSOLUTE path of the PSBLAS install directory> --prefix=<install_path>`
adding the options for MUMPS, SuperLU, SuperLU_Dist, UMFPACK as desired. adding the options for MUMPS, SuperLU, SuperLU_Dist, UMFPACK as desired.
See [AMG4PSBLAS User's and Reference Guide](docs/amg4psblas_1.0-guide.pdf) (Section 3) for details. See [AMG4PSBLAS User's and Reference Guide](docs/amg4psblas_1.2-guide.pdf) (Section 3) for details.
2. Tweak `Make.inc` if you are not satisfied. 2. Tweak `Make.inc` if you are not satisfied.
3. run `make`; 3. run `make`;
4. Go into the test subdirectory and build the examples of your choice. 4. Go into the test subdirectory and build the examples of your choice.
5. (if desired): `make install` 5. (if desired): `make install` or `sudo make install` if the install path requires privileged access.
>[!CAUTION] >[!CAUTION]
>The single precision version is supported only by MUMPS and SuperLU; >The single precision version is supported only by MUMPS and SuperLU;
@@ -53,13 +73,77 @@ in isolation and without these features.
>the corresponding preconditioner options will be available only from >the corresponding preconditioner options will be available only from
>the double precision version. >the double precision version.
## CMAKE
AMG4PSBLAS supports building with CMake. To configure the project, you must explicitly provide the path where PSBLAS is installed. If this path is not specified, the configuration will fail with a fatal error.
From the root directory of the project, run:
### 1. Create and enter the build directory
```
mkdir build
cd build
```
### 2. Configure the project (MANDATORY: specify your PSBLAS path)
```
cmake -DPSBLAS_INSTALL_DIR=</path/to/psblas/installation> ..
```
During this step, CMake will:
- Search for the PSBLAS package in the provided path.
- Detect and configure MPI (required for C, C++, and Fortran).
- Set up include and module directories based on the PSBLAS configuration.
- Configure integer sizes (IPK and LPK) to match the PSBLAS installation.
### 2.1. Customizing the Installation Path
By default, the library will be installed in standard system locations. To install amg4psblas in a custom directory, use the CMAKE_INSTALL_PREFIX variable:
```
cmake -DPSBLAS_INSTALL_DIR=</path/to/psblas/installation> \
-DCMAKE_INSTALL_PREFIX=</path/to/amg4psblas_install> ..
```
### 3. Compiling and Installing
Once configured, you can build the libraries (amg_prec and amg_cbind) and install them.
#### Build the library
```
make
```
#### Install the library, modules, and samples
```
make install
```
### CUDA, OpeMP, OpenACC ### CUDA, OpeMP, OpenACC
CUDA, OpenMP and OpenACC features are transparently inherited by PSBLAS installation. If PSBLAS has been configured (and installed) with these supports then AMG4PSBLAS will transparently inherit them. It will then be possible to move the computation to GPU accelerator simply by selecting the appropriate variable types. If these have not been activated or installed for PSBLAS then they will not be available for AMG4PSBLAS either and the operation will be purely on CPU/MPI. CUDA, OpenMP and OpenACC features are transparently inherited by PSBLAS installation.
If PSBLAS has been configured (and installed) with these supports then AMG4PSBLAS will
transparently inherit them. It will then be possible to move the computation to GPU accelerator
simply by selecting the appropriate variable types in the application.
If the types have not been activated or installed for PSBLAS then they will not be
available for AMG4PSBLAS either and the operation will be purely on CPU/MPI. See also the samples/cuda folder.
### EoCoE - Software as service portal ### EoCoE - Software as service portal
In the European project “Energy oriented Center of Excellence: toward exascale for energy” we made available a software as service portal: [https://eocoe.psnc.pl/](https://eocoe.psnc.pl/). This permits to test several cutting-edge computational methods for accelerating the transition to the production, storage and management of clean, decarbonized energy. Among them you have the possibility of running PSBLAS+AMG4PSBLAS on some test problems to become familiar with using the software. In the European project “Energy oriented Center of Excellence: toward exascale for energy” we made
available the software through a service portal: [https://eocoe.psnc.pl/](https://eocoe.psnc.pl/).
This permits to test several cutting-edge computational methods for accelerating the transition
to production, storage and management of clean, decarbonized energy.
Among them you have the possibility of running PSBLAS+AMG4PSBLAS on some test problems
to become familiar with using the software.
## MPI and Compilers
The library has been successfully compiled and tested with the same compilers
and MPI implementations as PSBLAS 3.9, which include:
- MPICH 4.2.3, 4.3.0, 4.3.2
- OpenMPI 4.1.8. 5.0.7, 5.0.8, 5.0.9
combined with
- GNU compilers 10.5.0, 11.5.0, 12.5.0, 13.3.0, 14.2.0 14.3.0, 15.2.0
- LLVM 20.1.0 and 21.1.0 (except OpenMPI 4.1.8 which does not build with LLVM)
Moreover, it has been tested with the Intel OneAPI toolchain versions 2025.2 and 2025.3
As of this release, the NVIDIA compiler 25.7 fails to handle our code.
Cray, IBM and NAg compilers have been used for testing in the past, but not on this version.
## TODO and bugs ## TODO and bugs
@@ -74,3 +158,9 @@ In the European project “Energy oriented Center of Excellence: toward exascale
- Fabio Durastante (University of Pisa and IAC-CNR, IT) - Fabio Durastante (University of Pisa and IAC-CNR, IT)
- Salvatore Filippone (University of Rome Tor Vergata and IAC-CNR, IT) - Salvatore Filippone (University of Rome Tor Vergata and IAC-CNR, IT)
**Contributors** (_roughly reverse cronological order_):
- Luca Pepè Sciarria
- Andrea Di Iorio
- Ambra Abdullahi Hassan
- Alfredo Buttari
+14
View File
@@ -1,5 +1,19 @@
WHAT'S NEW WHAT'S NEW
AMG4PSBLAS
Version 1.2
1. New polynomial smoothers.
2. Introduced L1-variants
3. Reorganization of sample programs.
Version 1.1
1. Reworked approximate inverse solvers.
Version 1.0
1. Transitioned from MLD2P4
MLD2P4
Version 2.1 Version 2.1
1. The multigrid preconditioner now include fully general V- and 1. The multigrid preconditioner now include fully general V- and
W-cycles. We also support K-cycles, both for symmetric and W-cycles. We also support K-cycles, both for symmetric and
+907
View File
@@ -0,0 +1,907 @@
set(AMG_amgprec_source_files
amg_s_ainv_solver.F90
amg_d_ainv_solver.F90
amg_z_base_solver_mod.f90
amg_z_slu_solver.F90
amg_z_gs_solver.f90
amg_d_ilu_fact_mod.f90
# amg_z_hybrid_aggregator_mod.F90
amg_c_base_smoother_mod.f90
amg_s_matchboxp_mod.F90
amg_c_gs_solver.f90
amg_z_prec_type.f90
amg_s_base_solver_mod.f90
amg_d_slu_solver.F90
amg_z_inner_mod.f90
amg_d_base_aggregator_mod.f90
amg_c_diag_solver.f90
amg_z_krm_solver.f90
impl/amg_zfile_prec_descr.f90
impl/amg_c_hierarchy_rebld.f90
impl/amg_dcprecset.F90
impl/amg_sprecinit.F90
impl/amg_cprecinit.F90
impl/amg_smlprec_aply.f90
impl/level/amg_s_base_onelev_map_rstr.F90
impl/level/amg_c_base_onelev_csetr.f90
impl/level/amg_d_base_onelev_map_rstr.F90
impl/level/amg_z_base_onelev_setsv.F90
impl/level/amg_d_base_onelev_descr.f90
impl/level/amg_d_base_onelev_setag.f90
impl/level/amg_s_base_onelev_dump.f90
impl/level/amg_s_base_onelev_build.f90
impl/level/amg_c_base_onelev_map_rstr.F90
impl/level/amg_z_base_onelev_memory_use.f90
impl/level/amg_s_base_onelev_map_prol.F90
impl/level/amg_d_base_onelev_csetc.F90
impl/level/amg_d_base_onelev_cnv.f90
impl/level/amg_c_base_onelev_setsv.F90
impl/level/amg_c_base_onelev_descr.f90
impl/level/amg_z_base_onelev_setsm.F90
impl/level/amg_d_base_onelev_csetr.f90
impl/level/amg_s_base_onelev_descr.f90
impl/level/amg_c_base_onelev_build.f90
impl/level/amg_c_base_onelev_setag.f90
impl/level/amg_c_base_onelev_free_smoothers.f90
impl/level/amg_c_base_onelev_memory_use.f90
impl/level/amg_s_base_onelev_csetr.f90
impl/level/amg_s_base_onelev_mat_asb.f90
impl/level/amg_c_base_onelev_free.f90
impl/level/amg_d_base_onelev_free_smoothers.f90
impl/level/amg_z_base_onelev_map_prol.F90
impl/level/amg_s_base_onelev_free_smoothers.f90
impl/level/amg_d_base_onelev_map_prol.F90
impl/level/amg_d_base_onelev_free.f90
impl/level/amg_z_base_onelev_cnv.f90
impl/level/amg_s_base_onelev_cseti.F90
impl/level/amg_s_base_onelev_csetc.F90
impl/level/amg_c_base_onelev_map_prol.F90
impl/level/amg_d_base_onelev_check.f90
impl/level/amg_d_base_onelev_setsm.F90
impl/level/amg_s_base_onelev_setsv.F90
impl/level/amg_z_base_onelev_mat_asb.f90
impl/level/amg_c_base_onelev_mat_asb.f90
impl/level/amg_z_base_onelev_cseti.F90
impl/level/amg_z_base_onelev_descr.f90
impl/level/amg_z_base_onelev_map_rstr.F90
impl/level/amg_z_base_onelev_check.f90
impl/level/amg_c_base_onelev_cnv.f90
impl/level/amg_z_base_onelev_build.f90
impl/level/amg_d_base_onelev_build.f90
impl/level/amg_c_base_onelev_cseti.F90
impl/level/amg_c_base_onelev_check.f90
impl/level/amg_s_base_onelev_check.f90
impl/level/amg_s_base_onelev_memory_use.f90
impl/level/amg_s_base_onelev_cnv.f90
impl/level/amg_z_base_onelev_setag.f90
impl/level/amg_s_base_onelev_free.f90
impl/level/amg_z_base_onelev_dump.f90
impl/level/amg_z_base_onelev_csetr.f90
impl/level/amg_z_base_onelev_free_smoothers.f90
impl/level/amg_c_base_onelev_csetc.F90
impl/level/amg_d_base_onelev_dump.f90
impl/level/amg_z_base_onelev_csetc.F90
impl/level/amg_d_base_onelev_setsv.F90
impl/level/amg_s_base_onelev_setsm.F90
impl/level/amg_d_base_onelev_mat_asb.f90
impl/level/amg_s_base_onelev_setag.f90
impl/level/amg_d_base_onelev_cseti.F90
impl/level/amg_d_base_onelev_memory_use.f90
impl/level/amg_c_base_onelev_setsm.F90
impl/level/amg_z_base_onelev_free.f90
impl/level/amg_c_base_onelev_dump.f90
impl/amg_z_hierarchy_bld.F90
impl/amg_zfile_prec_memory_use.f90
impl/amg_c_smoothers_bld.f90
impl/amg_dmlprec_aply.f90
impl/amg_cprecaply.f90
impl/amg_zcprecset.F90
impl/amg_z_smoothers_bld.f90
impl/amg_cprecset.F90
impl/amg_cfile_prec_memory_use.f90
impl/amg_z_extprol_bld.F90
impl/amg_sprecbld.f90
impl/amg_s_hierarchy_rebld.f90
impl/amg_s_smoothers_bld.f90
impl/amg_dprecinit.F90
impl/amg_zmlprec_bld.f90
impl/amg_smlprec_bld.f90
impl/amg_sfile_prec_memory_use.f90
impl/amg_dprecaply.f90
impl/amg_zprecbld.f90
impl/amg_z_hierarchy_rebld.f90
impl/amg_c_extprol_bld.F90
impl/amg_zprecaply.f90
impl/amg_s_extprol_bld.F90
impl/amg_dfile_prec_memory_use.f90
impl/solver/amg_z_invt_solver_clone_settings.f90
impl/solver/amg_c_gs_solver_clear_data.f90
impl/solver/amg_d_base_solver_apply.f90
impl/solver/amg_s_ilu_solver_apply.f90
impl/solver/amg_d_jac_solver_apply.f90
impl/solver/amg_z_base_solver_csetr.f90
impl/solver/amg_z_ilu_solver_dmp.f90
impl/solver/amg_d_diag_solver_dmp.f90
impl/solver/amg_c_invt_solver_check.f90
impl/solver/amg_z_base_solver_descr.f90
impl/solver/amg_d_mumps_solver_apply_vect.F90
impl/solver/amg_d_l1_jac_solver_bld.f90
impl/solver/amg_z_base_solver_cseti.f90
impl/solver/amg_d_ainv_solver_check.f90
impl/solver/amg_s_invt_solver_bld.f90
impl/solver/amg_z_ainv_solver_clone_settings.f90
impl/solver/amg_c_bwgs_solver_bld.f90
impl/solver/amg_z_base_ainv_solver_apply_vect.f90
impl/solver/amg_d_id_solver_apply.f90
impl/solver/amg_s_base_solver_apply_vect.f90
impl/solver/amg_s_base_solver_clone.f90
impl/solver/amg_c_base_ainv_update_a.f90
impl/solver/amg_s_id_solver_clone.f90
impl/solver/amg_s_invk_solver_clone_settings.f90
impl/solver/amg_z_ainv_solver_bld.f90
impl/solver/amg_z_diag_solver_cnv.f90
impl/solver/amg_d_mumps_solver_bld.F90
impl/solver/amg_d_jac_solver_clear_data.f90
impl/solver/amg_c_jac_solver_clone_settings.f90
impl/solver/amg_z_gs_solver_clear_data.f90
impl/solver/amg_c_ainv_solver_cseti.f90
impl/solver/amg_z_base_solver_cnv.f90
impl/solver/amg_s_bwgs_solver_bld.f90
impl/solver/amg_s_id_solver_apply_vect.f90
impl/solver/amg_z_jac_solver_clone.f90
impl/solver/amg_z_ainv_solver_check.f90
impl/solver/amg_d_ilu_solver_clear_data.f90
impl/solver/amg_s_invk_solver_cseti.f90
impl/solver/amg_s_ainv_solver_csetc.f90
impl/solver/amg_z_base_ainv_solver_apply.f90
impl/solver/amg_c_gs_solver_clone.f90
impl/solver/amg_d_base_ainv_solver_apply.f90
# impl/solver/amg_d_ainv_solver_setr.f90
impl/solver/amg_d_invt_solver_clone.f90
impl/solver/amg_d_gs_solver_apply_vect.f90
impl/solver/amg_s_base_solver_dmp.f90
impl/solver/amg_d_ainv_solver_descr.f90
impl/solver/amg_d_jac_solver_clone_settings.f90
impl/solver/amg_z_base_solver_check.f90
impl/solver/amg_z_diag_solver_clone.f90
impl/solver/amg_s_invk_solver_clone.f90
# impl/solver/amg_d_ainv_solver_setc.f90
impl/solver/amg_d_gs_solver_clear_data.f90
impl/solver/amg_c_invt_solver_bld.f90
impl/solver/amg_s_jac_solver_clear_data.f90
impl/solver/amg_d_jac_solver_dmp.f90
impl/solver/amg_c_base_solver_dmp.f90
impl/solver/amg_s_diag_solver_dmp.f90
impl/solver/amg_d_invt_solver_check.f90
impl/solver/amg_c_ilu_solver_clear_data.f90
impl/solver/amg_z_invt_solver_descr.f90
impl/solver/amg_d_diag_solver_clone.f90
impl/solver/amg_s_jac_solver_bld.f90
impl/solver/amg_s_mumps_solver_apply.F90
impl/solver/amg_z_jac_solver_clone_settings.f90
# impl/solver/amg_d_invt_solver_seti.f90
impl/solver/amg_s_base_ainv_solver_apply_vect.f90
impl/solver/amg_z_diag_solver_apply.f90
impl/solver/amg_s_base_solver_free.f90
impl/solver/amg_d_ainv_solver_clone.f90
impl/solver/amg_s_krm_solver_impl.f90
# impl/solver/amg_d_ainv_solver_seti.f90
impl/solver/amg_z_ainv_solver_clone.f90
impl/solver/amg_d_base_ainv_solver_free.f90
# impl/solver/amg_c_invk_solver_seti.f90
impl/solver/amg_s_ilu_solver_dmp.f90
impl/solver/amg_z_base_solver_apply.f90
impl/solver/amg_d_ilu_solver_apply_vect.f90
impl/solver/amg_z_jac_solver_dmp.f90
impl/solver/amg_c_base_ainv_solver_cnv.f90
impl/solver/amg_s_gs_solver_cnv.f90
impl/solver/amg_s_id_solver_apply.f90
impl/solver/amg_d_jac_solver_apply_vect.f90
impl/solver/amg_s_base_solver_bld.f90
impl/solver/amg_z_base_solver_csetc.f90
impl/solver/amg_d_gs_solver_cnv.f90
impl/solver/amg_d_bwgs_solver_apply.f90
impl/solver/amg_c_diag_solver_dmp.f90
impl/solver/amg_d_ilu_solver_dmp.f90
impl/solver/amg_s_base_solver_check.f90
impl/solver/amg_c_invk_solver_clone.f90
impl/solver/amg_d_invk_solver_check.f90
impl/solver/amg_z_ilu_solver_clone.f90
impl/solver/amg_d_base_solver_cseti.f90
impl/solver/amg_c_base_solver_bld.f90
impl/solver/amg_z_jac_solver_apply_vect.f90
impl/solver/amg_z_id_solver_apply.f90
impl/solver/amg_d_base_solver_bld.f90
# impl/solver/amg_s_ainv_solver_seti.f90
impl/solver/amg_z_jac_solver_bld.f90
impl/solver/amg_z_base_solver_apply_vect.f90
impl/solver/amg_d_base_solver_clone.f90
impl/solver/amg_d_ainv_solver_csetr.f90
impl/solver/amg_s_invt_solver_cseti.f90
impl/solver/amg_c_id_solver_apply_vect.f90
impl/solver/amg_s_mumps_solver_apply_vect.F90
impl/solver/amg_z_ilu_solver_apply.f90
impl/solver/amg_c_diag_solver_apply_vect.f90
impl/solver/amg_s_gs_solver_dmp.f90
impl/solver/amg_z_base_ainv_solver_dmp.f90
impl/solver/amg_c_diag_solver_cnv.f90
# impl/solver/amg_z_invt_solver_setr.f90
impl/solver/amg_z_diag_solver_apply_vect.f90
impl/solver/amg_d_ainv_solver_cseti.f90
impl/solver/amg_z_ilu_solver_clear_data.f90
impl/solver/amg_d_base_solver_csetc.f90
impl/solver/amg_c_invk_solver_descr.f90
impl/solver/amg_d_invt_solver_csetr.f90
impl/solver/amg_d_invt_solver_cseti.f90
impl/solver/amg_z_invk_solver_bld.f90
impl/solver/amg_s_jac_solver_clone.f90
impl/solver/amg_d_bwgs_solver_bld.f90
impl/solver/amg_z_diag_solver_bld.f90
impl/solver/amg_s_l1_jac_solver_bld.f90
impl/solver/amg_s_invt_solver_descr.f90
impl/solver/amg_s_ilu_solver_bld.f90
impl/solver/amg_c_gs_solver_clone_settings.f90
impl/solver/amg_c_jac_solver_bld.f90
impl/solver/amg_d_gs_solver_clone_settings.f90
impl/solver/amg_d_base_solver_descr.f90
impl/solver/amg_d_base_solver_dmp.f90
impl/solver/amg_c_ainv_solver_bld.f90
impl/solver/amg_s_invt_solver_check.f90
impl/solver/amg_z_gs_solver_apply_vect.f90
impl/solver/amg_z_ainv_solver_descr.f90
# impl/solver/amg_c_invt_solver_seti.f90
impl/solver/amg_c_base_solver_apply.f90
impl/solver/amg_z_gs_solver_dmp.f90
impl/solver/amg_d_ainv_solver_clone_settings.f90
impl/solver/amg_c_id_solver_apply.f90
impl/solver/amg_z_base_solver_clone.f90
impl/solver/amg_s_invk_solver_check.f90
impl/solver/amg_c_gs_solver_bld.f90
impl/solver/amg_s_ilu_solver_cnv.f90
impl/solver/amg_z_ainv_solver_csetc.f90
impl/solver/amg_s_ainv_solver_clone_settings.f90
impl/solver/amg_c_base_ainv_solver_apply_vect.f90
impl/solver/amg_s_diag_solver_apply.f90
impl/solver/amg_s_base_ainv_update_a.f90
impl/solver/amg_c_base_solver_csetc.f90
impl/solver/amg_c_jac_solver_clone.f90
impl/solver/amg_c_base_solver_descr.f90
impl/solver/amg_c_invt_solver_clone.f90
impl/solver/amg_c_ilu_solver_bld.f90
impl/solver/amg_d_base_ainv_solver_apply_vect.f90
impl/solver/amg_d_base_solver_apply_vect.f90
impl/solver/amg_z_invt_solver_check.f90
impl/solver/amg_c_base_solver_cseti.f90
impl/solver/amg_s_jac_solver_dmp.f90
# impl/solver/amg_s_invk_solver_seti.f90
impl/solver/amg_s_ainv_solver_check.f90
impl/solver/amg_d_base_solver_clear_data.f90
impl/solver/amg_z_gs_solver_clone_settings.f90
impl/solver/amg_c_invk_solver_check.f90
impl/solver/amg_s_base_solver_cseti.f90
impl/solver/amg_z_base_ainv_solver_free.f90
impl/solver/amg_z_invk_solver_clone_settings.f90
impl/solver/amg_c_base_ainv_solver_dmp.f90
impl/solver/amg_s_gs_solver_clear_data.f90
impl/solver/amg_s_base_ainv_solver_apply.f90
impl/solver/amg_c_base_solver_apply_vect.f90
impl/solver/amg_d_diag_solver_cnv.f90
impl/solver/amg_d_id_solver_apply_vect.f90
impl/solver/amg_z_base_solver_bld.f90
impl/solver/amg_z_base_solver_dmp.f90
impl/solver/amg_d_invt_solver_clone_settings.f90
impl/solver/amg_c_diag_solver_clone.f90
impl/solver/amg_z_gs_solver_apply.f90
impl/solver/amg_c_invt_solver_clone_settings.f90
impl/solver/amg_z_base_solver_free.f90
impl/solver/amg_d_diag_solver_clear_data.f90
impl/solver/amg_d_ilu_solver_clone_settings.f90
# impl/solver/amg_z_invt_solver_seti.f90
# impl/solver/amg_z_ainv_solver_seti.f90
impl/solver/amg_c_diag_solver_apply.f90
impl/solver/amg_d_base_ainv_solver_dmp.f90
impl/solver/amg_c_invt_solver_csetr.f90
# impl/solver/amg_c_invt_solver_setr.f90
impl/solver/amg_c_jac_solver_clear_data.f90
impl/solver/amg_c_invk_solver_bld.f90
impl/solver/amg_c_ainv_solver_csetc.f90
impl/solver/amg_s_ainv_solver_cseti.f90
impl/solver/amg_z_base_solver_clear_data.f90
impl/solver/amg_z_invk_solver_check.f90
impl/solver/amg_c_diag_solver_bld.f90
impl/solver/amg_d_invk_solver_clone_settings.f90
impl/solver/amg_s_ainv_solver_clone.f90
impl/solver/amg_s_diag_solver_clear_data.f90
impl/solver/amg_d_gs_solver_clone.f90
impl/solver/amg_s_base_solver_csetr.f90
impl/solver/amg_c_ilu_solver_dmp.f90
impl/solver/amg_c_base_solver_cnv.f90
# impl/solver/amg_z_ainv_solver_setc.f90
impl/solver/amg_z_jac_solver_apply.f90
impl/solver/amg_s_ainv_solver_descr.f90
impl/solver/amg_z_base_ainv_solver_cnv.f90
impl/solver/amg_c_ilu_solver_apply.f90
impl/solver/amg_c_ilu_solver_cnv.f90
impl/solver/amg_z_bwgs_solver_bld.f90
impl/solver/amg_c_base_ainv_solver_free.f90
impl/solver/amg_s_base_solver_clone_settings.f90
impl/solver/amg_z_invt_solver_bld.f90
impl/solver/amg_s_base_ainv_solver_free.f90
impl/solver/amg_s_base_solver_clear_data.f90
impl/solver/amg_s_invt_solver_csetr.f90
impl/solver/amg_d_diag_solver_apply_vect.f90
impl/solver/amg_s_diag_solver_bld.f90
impl/solver/amg_s_diag_solver_cnv.f90
impl/solver/amg_d_diag_solver_apply.f90
impl/solver/amg_d_invk_solver_descr.f90
impl/solver/amg_z_mumps_solver_apply.F90
impl/solver/amg_s_base_solver_descr.f90
impl/solver/amg_c_jac_solver_apply_vect.f90
impl/solver/amg_s_base_ainv_solver_dmp.f90
impl/solver/amg_z_krm_solver_impl.f90
impl/solver/amg_z_invt_solver_csetr.f90
impl/solver/amg_c_ainv_solver_check.f90
# impl/solver/amg_s_invt_solver_seti.f90
impl/solver/amg_z_ainv_solver_cseti.f90
impl/solver/amg_z_invk_solver_clone.f90
impl/solver/amg_s_base_solver_csetc.f90
impl/solver/amg_z_bwgs_solver_apply_vect.f90
impl/solver/amg_c_bwgs_solver_apply.f90
impl/solver/amg_c_base_solver_csetr.f90
impl/solver/amg_c_invk_solver_cseti.f90
impl/solver/amg_d_krm_solver_impl.f90
impl/solver/amg_s_invk_solver_bld.f90
impl/solver/amg_c_mumps_solver_apply.F90
impl/solver/amg_z_jac_solver_cnv.f90
# impl/solver/amg_s_ainv_solver_setr.f90
impl/solver/amg_d_gs_solver_bld.f90
impl/solver/amg_c_ilu_solver_clone_settings.f90
impl/solver/amg_z_base_solver_clone_settings.f90
impl/solver/amg_d_ilu_solver_clone.f90
impl/solver/amg_c_ilu_solver_clone.f90
impl/solver/amg_d_ainv_solver_bld.f90
impl/solver/amg_c_gs_solver_apply.f90
impl/solver/amg_z_mumps_solver_apply_vect.F90
impl/solver/amg_c_ainv_solver_clone.f90
impl/solver/amg_c_base_solver_clear_data.f90
impl/solver/amg_z_diag_solver_dmp.f90
impl/solver/amg_z_id_solver_apply_vect.f90
impl/solver/amg_d_ilu_solver_bld.f90
impl/solver/amg_s_base_solver_apply.f90
impl/solver/amg_s_ainv_solver_csetr.f90
impl/solver/amg_z_ilu_solver_cnv.f90
impl/solver/amg_s_invk_solver_descr.f90
impl/solver/amg_d_jac_solver_bld.f90
impl/solver/amg_z_invk_solver_cseti.f90
impl/solver/amg_z_id_solver_clone.f90
impl/solver/amg_d_id_solver_clone.f90
impl/solver/amg_z_diag_solver_clear_data.f90
impl/solver/amg_s_gs_solver_bld.f90
impl/solver/amg_s_bwgs_solver_apply.f90
impl/solver/amg_s_gs_solver_clone.f90
impl/solver/amg_s_jac_solver_apply.f90
impl/solver/amg_z_ilu_solver_clone_settings.f90
impl/solver/amg_c_mumps_solver_bld.F90
impl/solver/amg_d_mumps_solver_apply.F90
# impl/solver/amg_s_ainv_solver_setc.f90
impl/solver/amg_d_base_solver_cnv.f90
impl/solver/amg_s_ilu_solver_clear_data.f90
impl/solver/amg_d_bwgs_solver_apply_vect.f90
impl/solver/amg_s_jac_solver_apply_vect.f90
impl/solver/amg_c_invk_solver_clone_settings.f90
impl/solver/amg_c_base_solver_clone_settings.f90
impl/solver/amg_z_gs_solver_cnv.f90
impl/solver/amg_s_invt_solver_clone.f90
# impl/solver/amg_z_invk_solver_seti.f90
impl/solver/amg_c_ainv_solver_csetr.f90
impl/solver/amg_c_jac_solver_apply.f90
impl/solver/amg_c_gs_solver_dmp.f90
impl/solver/amg_z_ilu_solver_bld.f90
impl/solver/amg_c_invt_solver_descr.f90
impl/solver/amg_z_invt_solver_clone.f90
impl/solver/amg_d_base_ainv_update_a.f90
impl/solver/amg_c_base_solver_clone.f90
impl/solver/amg_s_diag_solver_clone.f90
impl/solver/amg_d_invt_solver_bld.f90
# impl/solver/amg_c_ainv_solver_setc.f90
impl/solver/amg_d_gs_solver_dmp.f90
impl/solver/amg_s_gs_solver_apply.f90
impl/solver/amg_d_jac_solver_clone.f90
impl/solver/amg_z_jac_solver_clear_data.f90
impl/solver/amg_c_invt_solver_cseti.f90
impl/solver/amg_d_ilu_solver_apply.f90
# impl/solver/amg_c_ainv_solver_setr.f90
impl/solver/amg_c_gs_solver_cnv.f90
impl/solver/amg_c_diag_solver_clear_data.f90
impl/solver/amg_c_base_solver_check.f90
impl/solver/amg_c_base_solver_free.f90
impl/solver/amg_z_invt_solver_cseti.f90
impl/solver/amg_d_base_solver_check.f90
impl/solver/amg_d_invk_solver_clone.f90
impl/solver/amg_c_krm_solver_impl.f90
impl/solver/amg_d_base_ainv_solver_cnv.f90
impl/solver/amg_d_invk_solver_cseti.f90
impl/solver/amg_z_mumps_solver_bld.F90
impl/solver/amg_z_gs_solver_bld.f90
# impl/solver/amg_z_ainv_solver_setr.f90
impl/solver/amg_s_gs_solver_apply_vect.f90
impl/solver/amg_s_jac_solver_clone_settings.f90
impl/solver/amg_z_gs_solver_clone.f90
impl/solver/amg_c_gs_solver_apply_vect.f90
impl/solver/amg_d_base_solver_csetr.f90
impl/solver/amg_s_ainv_solver_bld.f90
impl/solver/amg_z_l1_jac_solver_bld.f90
impl/solver/amg_z_base_ainv_update_a.f90
impl/solver/amg_z_ainv_solver_csetr.f90
impl/solver/amg_s_ilu_solver_apply_vect.f90
# impl/solver/amg_s_invt_solver_setr.f90
# impl/solver/amg_d_invt_solver_setr.f90
impl/solver/amg_d_invk_solver_bld.f90
impl/solver/amg_s_jac_solver_cnv.f90
impl/solver/amg_z_bwgs_solver_apply.f90
impl/solver/amg_s_bwgs_solver_apply_vect.f90
# impl/solver/amg_d_invk_solver_seti.f90
impl/solver/amg_d_ilu_solver_cnv.f90
impl/solver/amg_s_mumps_solver_bld.F90
impl/solver/amg_s_gs_solver_clone_settings.f90
impl/solver/amg_c_jac_solver_dmp.f90
impl/solver/amg_d_jac_solver_cnv.f90
impl/solver/amg_c_ilu_solver_apply_vect.f90
impl/solver/amg_c_mumps_solver_apply_vect.F90
impl/solver/amg_z_ilu_solver_apply_vect.f90
impl/solver/amg_s_ilu_solver_clone_settings.f90
impl/solver/amg_c_ainv_solver_clone_settings.f90
# impl/solver/amg_c_ainv_solver_seti.f90
impl/solver/amg_s_ilu_solver_clone.f90
impl/solver/amg_d_diag_solver_bld.f90
impl/solver/amg_c_l1_jac_solver_bld.f90
impl/solver/amg_c_bwgs_solver_apply_vect.f90
impl/solver/amg_c_jac_solver_cnv.f90
impl/solver/amg_c_id_solver_clone.f90
impl/solver/amg_d_gs_solver_apply.f90
impl/solver/amg_z_invk_solver_descr.f90
impl/solver/amg_s_diag_solver_apply_vect.f90
impl/solver/amg_s_base_solver_cnv.f90
impl/solver/amg_d_base_solver_clone_settings.f90
impl/solver/amg_s_invt_solver_clone_settings.f90
impl/solver/amg_d_ainv_solver_csetc.f90
impl/solver/amg_d_invt_solver_descr.f90
impl/solver/amg_d_base_solver_free.f90
impl/solver/amg_c_base_ainv_solver_apply.f90
impl/solver/amg_s_base_ainv_solver_cnv.f90
impl/solver/amg_c_ainv_solver_descr.f90
impl/amg_sfile_prec_descr.f90
impl/amg_zprecinit.F90
impl/amg_dprecbld.f90
impl/amg_sprecaply.f90
impl/amg_cprecbld.f90
impl/amg_cfile_prec_descr.f90
impl/amg_s_hierarchy_bld.F90
impl/amg_dfile_prec_descr.f90
impl/amg_ccprecset.F90
impl/amg_d_hierarchy_bld.F90
impl/amg_c_hierarchy_bld.F90
impl/smoother/amg_d_base_smoother_clone_settings.f90
impl/smoother/amg_d_as_smoother_check.f90
impl/smoother/amg_c_l1_jac_smoother_clone.f90
impl/smoother/amg_z_l1_jac_smoother_bld.f90
impl/smoother/amg_s_poly_smoother_clear_data.f90
impl/smoother/amg_s_poly_smoother_apply_vect.f90
impl/smoother/amg_z_jac_smoother_clone_settings.f90
impl/smoother/amg_s_poly_smoother_csetc.f90
impl/smoother/amg_s_as_smoother_prol_a.f90
impl/smoother/amg_s_base_smoother_csetc.f90
impl/smoother/amg_s_as_smoother_apply.f90
impl/smoother/amg_z_base_smoother_csetr.f90
impl/smoother/amg_c_jac_smoother_apply.f90
impl/smoother/amg_s_base_smoother_clone.f90
impl/smoother/amg_d_jac_smoother_dmp.f90
impl/smoother/amg_z_base_smoother_cnv.f90
impl/smoother/amg_s_jac_smoother_apply.f90
impl/smoother/amg_z_jac_smoother_bld.f90
impl/smoother/amg_c_as_smoother_clone.f90
impl/smoother/amg_d_as_smoother_apply_vect.f90
impl/smoother/amg_d_poly_smoother_descr.f90
impl/smoother/amg_s_as_smoother_csetc.f90
impl/smoother/amg_z_base_smoother_cseti.f90
impl/smoother/amg_s_base_smoother_cseti.f90
impl/smoother/amg_s_base_smoother_free.f90
impl/smoother/amg_d_jac_smoother_clone.f90
impl/smoother/amg_d_jac_smoother_apply_vect.f90
impl/smoother/amg_c_as_smoother_clear_data.f90
impl/smoother/amg_s_poly_smoother_descr.f90
impl/smoother/amg_z_as_smoother_cseti.f90
impl/smoother/amg_s_as_smoother_apply_vect.f90
impl/smoother/amg_c_jac_smoother_csetr.f90
impl/smoother/amg_d_base_smoother_free.f90
impl/smoother/amg_z_as_smoother_bld.f90
impl/smoother/amg_s_base_smoother_clear_data.f90
impl/smoother/amg_c_jac_smoother_bld.f90
impl/smoother/amg_d_as_smoother_restr_v.f90
impl/smoother/amg_c_as_smoother_check.f90
impl/smoother/amg_d_poly_smoother_cseti.f90
impl/smoother/amg_d_as_smoother_clone.f90
impl/smoother/amg_z_as_smoother_clear_data.f90
impl/smoother/amg_d_as_smoother_free.f90
impl/smoother/amg_s_as_smoother_cnv.f90
impl/smoother/amg_s_base_smoother_dmp.f90
impl/smoother/amg_d_l1_jac_smoother_descr.f90
impl/smoother/amg_s_poly_smoother_cnv.f90
impl/smoother/amg_d_jac_smoother_csetr.f90
impl/smoother/amg_d_base_smoother_apply.f90
impl/smoother/amg_s_as_smoother_cseti.f90
impl/smoother/amg_s_base_smoother_apply_vect.f90
impl/smoother/amg_c_base_smoother_cseti.f90
impl/smoother/amg_c_as_smoother_cnv.f90
impl/smoother/amg_z_jac_smoother_cnv.f90
impl/smoother/amg_s_poly_smoother_bld.f90
impl/smoother/amg_d_jac_smoother_cseti.f90
impl/smoother/amg_s_as_smoother_prol_v.f90
impl/smoother/amg_c_as_smoother_restr_a.f90
impl/smoother/amg_d_base_smoother_bld.f90
impl/smoother/amg_c_jac_smoother_clone.f90
impl/smoother/amg_d_jac_smoother_bld.f90
impl/smoother/amg_z_jac_smoother_apply_vect.f90
impl/smoother/amg_c_as_smoother_prol_v.f90
impl/smoother/amg_z_jac_smoother_csetc.f90
impl/smoother/amg_z_as_smoother_prol_v.f90
impl/smoother/amg_d_base_smoother_cnv.f90
impl/smoother/amg_c_l1_jac_smoother_bld.f90
impl/smoother/amg_z_as_smoother_apply_vect.f90
impl/smoother/amg_s_as_smoother_restr_v.f90
impl/smoother/amg_d_l1_jac_smoother_bld.f90
impl/smoother/amg_s_jac_smoother_bld.f90
impl/smoother/amg_s_poly_smoother_clone_settings.f90
impl/smoother/amg_d_base_smoother_check.f90
impl/smoother/amg_z_base_smoother_bld.f90
impl/smoother/amg_s_l1_jac_smoother_clone.f90
impl/smoother/amg_c_jac_smoother_clone_settings.f90
impl/smoother/amg_s_poly_smoother_dmp.f90
impl/smoother/amg_c_base_smoother_csetr.f90
impl/smoother/amg_d_poly_smoother_clone_settings.f90
impl/smoother/amg_z_as_smoother_clone_settings.f90
impl/smoother/amg_z_jac_smoother_csetr.f90
impl/smoother/amg_d_jac_smoother_csetc.f90
impl/smoother/amg_z_base_smoother_dmp.f90
impl/smoother/amg_s_jac_smoother_csetr.f90
impl/smoother/amg_s_base_smoother_bld.f90
impl/smoother/amg_z_jac_smoother_descr.f90
impl/smoother/amg_z_jac_smoother_cseti.f90
impl/smoother/amg_d_as_smoother_dmp.f90
impl/smoother/amg_d_jac_smoother_apply.f90
impl/smoother/amg_c_jac_smoother_dmp.f90
impl/smoother/amg_z_as_smoother_apply.f90
impl/smoother/amg_z_as_smoother_check.f90
impl/smoother/amg_z_jac_smoother_clear_data.f90
impl/smoother/amg_s_base_smoother_descr.f90
impl/smoother/amg_s_jac_smoother_clone.f90
impl/smoother/amg_z_jac_smoother_clone.f90
impl/smoother/amg_c_as_smoother_clone_settings.f90
impl/smoother/amg_c_base_smoother_check.f90
impl/smoother/amg_d_poly_smoother_apply_vect.f90
impl/smoother/amg_s_l1_jac_smoother_bld.f90
impl/smoother/amg_c_as_smoother_apply_vect.f90
impl/smoother/amg_z_as_smoother_cnv.f90
impl/smoother/amg_z_as_smoother_csetc.f90
impl/smoother/amg_d_as_smoother_csetc.f90
impl/smoother/amg_d_jac_smoother_cnv.f90
impl/smoother/amg_c_as_smoother_csetc.f90
impl/smoother/amg_z_base_smoother_clone_settings.f90
impl/smoother/amg_s_as_smoother_free.f90
impl/smoother/amg_z_base_smoother_free.f90
impl/smoother/amg_c_base_smoother_apply.f90
impl/smoother/amg_z_l1_jac_smoother_descr.f90
impl/smoother/amg_s_as_smoother_clone_settings.f90
impl/smoother/amg_d_base_smoother_csetr.f90
impl/smoother/amg_c_jac_smoother_clear_data.f90
impl/smoother/amg_d_poly_smoother_bld.f90
impl/smoother/amg_z_base_smoother_csetc.f90
impl/smoother/amg_z_base_smoother_clone.f90
impl/smoother/amg_s_jac_smoother_apply_vect.f90
impl/smoother/amg_z_base_smoother_clear_data.f90
impl/smoother/amg_c_base_smoother_clone_settings.f90
impl/smoother/amg_d_base_smoother_clone.f90
impl/smoother/amg_d_base_smoother_cseti.f90
impl/smoother/amg_z_l1_jac_smoother_clone.f90
impl/smoother/amg_s_l1_jac_smoother_descr.f90
impl/smoother/amg_c_jac_smoother_descr.f90
impl/smoother/amg_z_base_smoother_check.f90
impl/smoother/amg_d_jac_smoother_clear_data.f90
impl/smoother/amg_d_as_smoother_prol_a.f90
impl/smoother/amg_c_as_smoother_apply.f90
impl/smoother/amg_c_base_smoother_cnv.f90
impl/smoother/amg_c_jac_smoother_cnv.f90
impl/smoother/amg_c_base_smoother_csetc.f90
impl/smoother/amg_d_base_smoother_csetc.f90
impl/smoother/amg_d_poly_smoother_csetr.f90
impl/smoother/amg_c_jac_smoother_cseti.f90
impl/smoother/amg_s_base_smoother_cnv.f90
impl/smoother/amg_s_poly_smoother_csetr.f90
impl/smoother/amg_s_base_smoother_clone_settings.f90
impl/smoother/amg_s_as_smoother_restr_a.f90
impl/smoother/amg_d_base_smoother_dmp.f90
impl/smoother/amg_d_jac_smoother_descr.f90
impl/smoother/amg_c_base_smoother_free.f90
impl/smoother/amg_c_as_smoother_free.f90
impl/smoother/amg_s_jac_smoother_clear_data.f90
impl/smoother/amg_s_jac_smoother_cseti.f90
impl/smoother/amg_d_poly_smoother_clone.f90
impl/smoother/amg_s_jac_smoother_csetc.f90
impl/smoother/amg_s_as_smoother_dmp.f90
impl/smoother/amg_s_base_smoother_apply.f90
impl/smoother/amg_s_as_smoother_clone.f90
impl/smoother/amg_c_l1_jac_smoother_descr.f90
impl/smoother/amg_s_jac_smoother_cnv.f90
impl/smoother/amg_z_as_smoother_free.f90
impl/smoother/amg_s_poly_smoother_clone.f90
impl/smoother/amg_s_as_smoother_clear_data.f90
impl/smoother/amg_s_jac_smoother_dmp.f90
impl/smoother/amg_c_base_smoother_clone.f90
impl/smoother/amg_d_poly_smoother_csetc.f90
impl/smoother/amg_d_as_smoother_cseti.f90
impl/smoother/amg_z_base_smoother_descr.f90
impl/smoother/amg_d_as_smoother_restr_a.f90
impl/smoother/amg_s_base_smoother_check.f90
impl/smoother/amg_c_as_smoother_restr_v.f90
impl/smoother/amg_d_poly_smoother_cnv.f90
impl/smoother/amg_c_jac_smoother_csetc.f90
impl/smoother/amg_z_jac_smoother_dmp.f90
impl/smoother/amg_z_base_smoother_apply.f90
impl/smoother/amg_s_base_smoother_csetr.f90
impl/smoother/amg_d_as_smoother_apply.f90
impl/smoother/amg_c_as_smoother_prol_a.f90
impl/smoother/amg_d_poly_smoother_clear_data.f90
impl/smoother/amg_c_base_smoother_descr.f90
impl/smoother/amg_d_as_smoother_bld.f90
impl/smoother/amg_c_as_smoother_bld.f90
impl/smoother/amg_c_as_smoother_cseti.f90
impl/smoother/amg_s_as_smoother_bld.f90
impl/smoother/amg_z_as_smoother_restr_a.f90
impl/smoother/amg_d_as_smoother_clear_data.f90
impl/smoother/amg_d_l1_jac_smoother_clone.f90
impl/smoother/amg_c_base_smoother_dmp.f90
impl/smoother/amg_d_base_smoother_descr.f90
impl/smoother/amg_c_base_smoother_apply_vect.f90
impl/smoother/amg_d_base_smoother_apply_vect.f90
impl/smoother/amg_c_base_smoother_clear_data.f90
impl/smoother/amg_d_poly_smoother_dmp.f90
impl/smoother/amg_s_poly_smoother_cseti.f90
impl/smoother/amg_s_as_smoother_check.f90
impl/smoother/amg_s_jac_smoother_descr.f90
impl/smoother/amg_d_jac_smoother_clone_settings.f90
impl/smoother/amg_d_as_smoother_prol_v.f90
impl/smoother/amg_z_jac_smoother_apply.f90
impl/smoother/amg_d_as_smoother_cnv.f90
impl/smoother/amg_c_jac_smoother_apply_vect.f90
impl/smoother/amg_c_as_smoother_dmp.f90
impl/smoother/amg_c_base_smoother_bld.f90
impl/smoother/amg_d_as_smoother_clone_settings.f90
impl/smoother/amg_d_base_smoother_clear_data.f90
impl/smoother/amg_s_jac_smoother_clone_settings.f90
impl/smoother/amg_z_as_smoother_dmp.f90
impl/smoother/amg_z_as_smoother_clone.f90
impl/smoother/amg_z_as_smoother_restr_v.f90
impl/smoother/amg_z_as_smoother_prol_a.f90
impl/smoother/amg_z_base_smoother_apply_vect.f90
impl/amg_d_smoothers_bld.f90
impl/amg_zprecset.F90
impl/amg_d_hierarchy_rebld.f90
impl/amg_d_extprol_bld.F90
impl/amg_dprecset.F90
impl/amg_scprecset.F90
impl/amg_sprecset.F90
impl/amg_dmlprec_bld.f90
impl/amg_zmlprec_aply.f90
impl/aggregator/amg_d_dec_aggregator_tprol.f90
impl/aggregator/amg_s_parmatch_aggregator_mat_asb.F90
impl/aggregator/amg_s_parmatch_aggregator_tprol.F90
impl/aggregator/amg_z_dec_aggregator_tprol.f90
impl/aggregator/amg_saggrmat_smth_bld.f90
impl/aggregator/amg_s_soc2_map_bld.F90
impl/aggregator/amg_s_parmatch_spmm_bld_inner.F90
impl/aggregator/amg_caggrmat_minnrg_bld.f90
impl/aggregator/amg_d_soc2_map_bld.F90
impl/aggregator/amg_s_dec_aggregator_tprol.f90
impl/aggregator/amg_s_parmatch_aggregator_inner_mat_asb.F90
impl/aggregator/amg_s_dec_aggregator_mat_bld.f90
impl/aggregator/amg_c_dec_aggregator_mat_asb.f90
impl/aggregator/amg_s_rap.f90
impl/aggregator/amg_s_map_to_tprol.f90
impl/aggregator/amg_d_parmatch_aggregator_tprol.F90
impl/aggregator/amg_saggrmat_nosmth_bld.f90
impl/aggregator/amg_c_soc1_map_bld.F90
impl/aggregator/amg_d_parmatch_aggregator_mat_asb.F90
impl/aggregator/amg_zaggrmat_smth_bld.f90
impl/aggregator/amg_d_parmatch_smth_bld.F90
impl/aggregator/amg_caggrmat_nosmth_bld.f90
impl/aggregator/amg_c_map_to_tprol.f90
impl/aggregator/amg_d_rap.f90
impl/aggregator/amg_d_map_to_tprol.f90
impl/aggregator/amg_daggrmat_minnrg_bld.f90
impl/aggregator/amg_d_dec_aggregator_mat_asb.f90
impl/aggregator/amg_z_dec_aggregator_mat_bld.f90
impl/aggregator/amg_d_parmatch_spmm_bld.F90
impl/aggregator/amg_d_parmatch_aggregator_mat_bld.F90
impl/aggregator/amg_d_ptap_bld.f90
impl/aggregator/amg_z_symdec_aggregator_tprol.f90
impl/aggregator/amg_s_symdec_aggregator_tprol.f90
impl/aggregator/amg_z_soc1_map_bld.F90
impl/aggregator/amg_d_parmatch_unsmth_bld.F90
impl/aggregator/amg_z_map_to_tprol.f90
impl/aggregator/amg_d_soc1_map_bld.F90
impl/aggregator/amg_d_parmatch_spmm_bld_ov.F90
impl/aggregator/amg_s_parmatch_aggregator_mat_bld.F90
impl/aggregator/amg_s_parmatch_unsmth_bld.F90
impl/aggregator/amg_d_parmatch_aggregator_inner_mat_asb.F90
impl/aggregator/amg_s_parmatch_spmm_bld.F90
impl/aggregator/amg_c_symdec_aggregator_tprol.f90
impl/aggregator/amg_zaggrmat_minnrg_bld.f90
impl/aggregator/amg_c_dec_aggregator_tprol.f90
impl/aggregator/amg_z_dec_aggregator_mat_asb.f90
impl/aggregator/amg_c_rap.f90
impl/aggregator/amg_s_parmatch_spmm_bld_ov.F90
impl/aggregator/amg_s_ptap_bld.f90
impl/aggregator/amg_s_soc1_map_bld.F90
impl/aggregator/amg_d_dec_aggregator_mat_bld.f90
impl/aggregator/amg_z_ptap_bld.f90
impl/aggregator/amg_daggrmat_smth_bld.f90
impl/aggregator/amg_z_soc2_map_bld.F90
impl/aggregator/amg_caggrmat_smth_bld.f90
impl/aggregator/amg_saggrmat_minnrg_bld.f90
impl/aggregator/amg_c_soc2_map_bld.F90
impl/aggregator/amg_s_dec_aggregator_mat_asb.f90
impl/aggregator/amg_z_rap.f90
impl/aggregator/amg_s_parmatch_smth_bld.F90
impl/aggregator/amg_c_dec_aggregator_mat_bld.f90
impl/aggregator/amg_daggrmat_nosmth_bld.f90
impl/aggregator/amg_d_symdec_aggregator_tprol.f90
impl/aggregator/amg_d_parmatch_spmm_bld_inner.F90
impl/aggregator/amg_c_ptap_bld.f90
impl/aggregator/amg_zaggrmat_nosmth_bld.f90
impl/amg_cmlprec_aply.f90
impl/amg_cmlprec_bld.f90
amg_d_invt_solver.f90
amg_c_id_solver.f90
amg_base_ainv_mod.F90
amg_d_matchboxp_mod.F90
amg_z_base_smoother_mod.f90
amg_s_invk_solver.f90
amg_c_base_solver_mod.f90
amg_s_ilu_solver.f90
amg_z_ilu_fact_mod.f90
amg_prec_mod.f90
amg_d_gs_solver.f90
amg_d_jac_smoother.f90
amg_z_symdec_aggregator_mod.f90
amg_s_gs_solver.f90
amg_ainv_mod.f90
amg_d_parmatch_aggregator_mod.F90
amg_z_as_smoother.f90
amg_c_inner_mod.f90
amg_d_poly_smoother.f90
amg_z_onelev_mod.f90
amg_z_diag_solver.f90
amg_c_symdec_aggregator_mod.f90
amg_c_prec_mod.f90
amg_d_sludist_solver.F90
amg_d_base_solver_mod.f90
amg_c_dec_aggregator_mod.f90
amg_c_ilu_fact_mod.f90
amg_s_onelev_mod.f90
amg_d_base_ainv_mod.f90
amg_d_invk_solver.f90
amg_z_invt_solver.f90
amg_z_prec_mod.f90
amg_s_prec_mod.f90
amg_d_mumps_solver.F90
amg_d_umf_solver.F90
# amg_d_hybrid_aggregator_mod.F90
amg_d_id_solver.f90
# amg_c_hybrid_aggregator_mod.F90
amg_z_base_ainv_mod.f90
amg_z_sludist_solver.F90
amg_d_ilu_solver.f90
amg_s_base_ainv_mod.f90
amg_c_invt_solver.f90
# amg_s_hybrid_aggregator_mod.F90
amg_d_prec_type.f90
amg_d_base_smoother_mod.f90
amg_c_base_ainv_mod.f90
amg_s_prec_type.f90
amg_s_diag_solver.f90
amg_z_base_aggregator_mod.f90
amg_z_dec_aggregator_mod.f90
amg_prec_type.f90
amg_s_invt_solver.f90
amg_s_base_smoother_mod.f90
amg_c_ainv_solver.F90
amg_d_dec_aggregator_mod.f90
amg_s_slu_solver.F90
amg_d_diag_solver.f90
amg_z_id_solver.f90
amg_c_slu_solver.F90
amg_s_jac_smoother.f90
amg_s_dec_aggregator_mod.f90
amg_d_inner_mod.f90
amg_s_mumps_solver.F90
amg_d_jac_solver.f90
amg_s_krm_solver.f90
amg_s_as_smoother.f90
amg_d_onelev_mod.f90
amg_z_jac_solver.f90
amg_d_symdec_aggregator_mod.f90
amg_c_onelev_mod.f90
amg_s_parmatch_aggregator_mod.F90
amg_c_ilu_solver.f90
amg_d_poly_coeff_mod.f90
amg_s_jac_solver.f90
amg_base_prec_type.F90
amg_s_base_aggregator_mod.f90
amg_z_ainv_solver.F90
amg_d_prec_mod.f90
amg_c_prec_type.f90
amg_d_as_smoother.f90
amg_z_ilu_solver.f90
amg_c_base_aggregator_mod.f90
amg_s_id_solver.f90
amg_c_krm_solver.f90
amg_z_jac_smoother.f90
amg_c_as_smoother.f90
amg_z_invk_solver.f90
amg_d_krm_solver.f90
amg_c_invk_solver.f90
amg_c_mumps_solver.F90
amg_c_jac_solver.f90
amg_z_umf_solver.F90
amg_s_symdec_aggregator_mod.f90
amg_s_poly_smoother.f90
amg_s_inner_mod.f90
amg_s_ilu_fact_mod.f90
amg_z_mumps_solver.F90
amg_c_jac_smoother.f90
)
foreach(file IN LISTS AMG_amgprec_source_files)
list(APPEND amgprec_source_files ${CMAKE_CURRENT_LIST_DIR}/${file})
endforeach()
list(APPEND AMG_amgprec_source_C_files impl/amg_dslu_interface.c)
list(APPEND AMG_amgprec_source_C_files impl/amg_zslu_interface.c)
list(APPEND AMG_amgprec_source_C_files impl/amg_sslu_interface.c)
list(APPEND AMG_amgprec_source_C_files impl/amg_dumf_interface.c)
list(APPEND AMG_amgprec_source_C_files impl/amg_cslu_interface.c)
list(APPEND AMG_amgprec_source_C_files impl/amg_dslud_interface.c)
list(APPEND AMG_amgprec_source_C_files impl/amg_zumf_interface.c)
list(APPEND AMG_amgprec_source_C_files impl/amg_zslud_interface.c)
set(AMG_amgprec_source_CPP_files
impl/aggregator/computeCandidateMate.cpp
impl/aggregator/processExposedVertex.cpp
impl/aggregator/processMatchedVertices.cpp
impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateCMP.cpp
impl/aggregator/processCrossEdge.cpp
impl/aggregator/findOwnerOfGhost.cpp
impl/aggregator/MatchBoxPC.cpp
impl/aggregator/queueTransfer.cpp
impl/aggregator/clean.cpp
impl/aggregator/algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.cpp
impl/aggregator/extractUChunk.cpp
impl/aggregator/processMatchedVerticesAndSendMessages.cpp
impl/aggregator/sendBundledMessages.cpp
impl/aggregator/initialize.cpp
impl/aggregator/isAlreadyMatched.cpp
impl/aggregator/processMessages.cpp
impl/aggregator/parallelComputeCandidateMateB.cpp
)
foreach(file IN LISTS AMG_amgprec_source_C_files)
list(APPEND amgprec_source_C_files ${CMAKE_CURRENT_LIST_DIR}/${file})
endforeach()
foreach(file IN LISTS AMG_amgprec_source_CPP_files)
list(APPEND amgprec_source_CPP_files ${CMAKE_CURRENT_LIST_DIR}/${file})
endforeach()
+11 -12
View File
@@ -58,30 +58,29 @@ MODOBJS=amg_base_prec_type.o amg_prec_type.o amg_prec_mod.o \
$(SMODOBJS) $(DMODOBJS) $(CMODOBJS) $(ZMODOBJS) $(SMODOBJS) $(DMODOBJS) $(CMODOBJS) $(ZMODOBJS)
OBJS=$(MODOBJS) LOCAL_MODS=$(MODOBJS:.o=$(.mod)) amg_c_l1_diag_solver$(.mod) amg_s_l1_diag_solver$(.mod) \
amg_d_l1_diag_solver$(.mod) amg_z_l1_diag_solver$(.mod)
LOCAL_MODS=$(MODOBJS:.o=$(.mod))
LIBNAME=libamg_prec.a LIBNAME=libamg_prec.a
all: objs impld all: mods objs impld
objs: $(OBJS) mods: $(MODOBJS)
/bin/cp -p amg_const.h $(INCDIR) /bin/cp -p amg_config.h $(INCDIR)
/bin/cp -p *$(.mod) $(MODDIR) /bin/cp -p *$(.mod) $(MODDIR)
objs: mods impld
impld: objs impld: mods
cd impl && $(MAKE) cd impl && $(MAKE)
lib: $(OBJS) impld lib: objs
cd impl && $(MAKE) lib cd impl && $(MAKE) lib
$(AR) $(HERE)/$(LIBNAME) $(OBJS) $(AR) $(HERE)/$(LIBNAME) $(MODOBJS)
$(RANLIB) $(HERE)/$(LIBNAME) $(RANLIB) $(HERE)/$(LIBNAME)
/bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR) /bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR)
$(MODOBJS): $(PSBLAS_MODDIR)/$(PSBBASEMODNAME)$(.mod) $(MODOBJS): $(PSBLAS_MODDIR)/$(PSBBASEMODNAME)$(.mod)
amg_base_prec_type.o: amg_const.h amg_base_prec_type.o: amg_config.h
amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o : amg_base_prec_type.o amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o : amg_base_prec_type.o
amg_prec_type.o: amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o amg_prec_type.o: amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o
amg_prec_mod.o: amg_prec_type.o amg_s_prec_mod.o amg_d_prec_mod.o amg_c_prec_mod.o amg_z_prec_mod.o amg_prec_mod.o: amg_prec_type.o amg_s_prec_mod.o amg_d_prec_mod.o amg_c_prec_mod.o amg_z_prec_mod.o
@@ -221,7 +220,7 @@ veryclean: clean
/bin/rm -f $(LIBNAME) /bin/rm -f $(LIBNAME)
clean: implclean clean: implclean
/bin/rm -f $(OBJS) $(LOCAL_MODS) *$(.mod) /bin/rm -f $(MODOBJS) $(LOCAL_MODS) *$(.mod)
implclean: implclean:
cd impl && $(MAKE) clean cd impl && $(MAKE) clean
-16
View File
@@ -1,16 +0,0 @@
#!/bin/bash
hn=amg_const.h
fn=amg_base_prec_type.F90
echo "/* This file was generated by a script using the $fn file as a basis. */" > $hn
echo '#ifndef AMG_CONST_H_' >> $hn
echo '#define AMG_CONST_H_' >> $hn
echo '#ifdef __cplusplus' >> $hn
echo 'extern "C" { ' >> $hn
echo '#endif' >> $hn
cat $fn | sed 's/=/= (/g;s/$/ )/g' | grep '\(^ *!\)\|parameter' | grep '_\>' | sed 's/^\s*//g;s/^.*:://g;s/\s*=\s*/ /g' | sed 's/,/\n/g;s/^ //g' | tr '[:lower:]' '[:upper:]' | grep ^AMG | sed 's/^/#define /g' >> $hn
echo '#ifdef __cplusplus' >> $hn
echo '}' >> $hn
echo '#endif' >> $hn
echo '#endif' >> $hn
exit
+1 -1
View File
@@ -17,7 +17,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+1 -5
View File
@@ -17,7 +17,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -55,10 +55,6 @@ module amg_base_ainv_mod
integer, parameter :: amg_ainv_llk_noth_ = amg_ainv_s_ft_llk_ + 1 integer, parameter :: amg_ainv_llk_noth_ = amg_ainv_s_ft_llk_ + 1
integer, parameter :: amg_ainv_mlk_ = amg_ainv_llk_noth_ + 1 integer, parameter :: amg_ainv_mlk_ = amg_ainv_llk_noth_ + 1
integer, parameter :: amg_ainv_lmx_ = amg_ainv_mlk_ integer, parameter :: amg_ainv_lmx_ = amg_ainv_mlk_
#if defined(HAVE_TUMA_SAINV)
integer, parameter :: amg_ainv_s_tuma_ = amg_ainv_lmx_ + 1
integer, parameter :: amg_ainv_l_tuma_ = amg_ainv_s_tuma_ + 1
#endif
end module amg_base_ainv_mod end module amg_base_ainv_mod
+12 -8
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -81,10 +81,10 @@ module amg_base_prec_type
! !
! Version numbers ! Version numbers
! !
character(len=*), parameter :: amg_version_string_ = "1.1.0" character(len=*), parameter :: amg_version_string_ = "1.2.0"
integer(psb_ipk_), parameter :: amg_version_major_ = 1 integer(psb_ipk_), parameter :: amg_version_major_ = 1
integer(psb_ipk_), parameter :: amg_version_minor_ = 1 integer(psb_ipk_), parameter :: amg_version_minor_ = 2
integer(psb_ipk_), parameter :: amg_patchlevel_ = 0 integer(psb_ipk_), parameter :: amg_patchlevel_ = 1
type amg_ml_parms type amg_ml_parms
integer(psb_ipk_) :: sweeps_pre, sweeps_post integer(psb_ipk_) :: sweeps_pre, sweeps_post
@@ -621,9 +621,13 @@ contains
subroutine amg_warn_coarse_mat(val,expected) subroutine amg_warn_coarse_mat(val,expected)
integer(psb_ipk_) :: val, expected integer(psb_ipk_) :: val, expected
integer(psb_mpk_) :: mval, mexp
if (val /= expected) then if (val /= expected) then
mval = val
mexp = expected
write(0,*) 'Warning: resetting COARSE_MAT on an existing hierarchy from ',& write(0,*) 'Warning: resetting COARSE_MAT on an existing hierarchy from ',&
& amg_get_coarse_mat_name(val), ' to ',amg_get_coarse_mat_name(expected) & amg_get_coarse_mat_name(mval), &
& ' to ',amg_get_coarse_mat_name(mexp)
end if end if
end subroutine amg_warn_coarse_mat end subroutine amg_warn_coarse_mat
@@ -1207,7 +1211,7 @@ contains
implicit none implicit none
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
type(amg_ml_parms), intent(inout) :: dat type(amg_ml_parms), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_), intent(in), optional :: root
call psb_bcast(ctxt,dat%sweeps_pre,root) call psb_bcast(ctxt,dat%sweeps_pre,root)
call psb_bcast(ctxt,dat%sweeps_post,root) call psb_bcast(ctxt,dat%sweeps_post,root)
@@ -1229,7 +1233,7 @@ contains
implicit none implicit none
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
type(amg_sml_parms), intent(inout) :: dat type(amg_sml_parms), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_), intent(in), optional :: root
call psb_bcast(ctxt,dat%amg_ml_parms,root) call psb_bcast(ctxt,dat%amg_ml_parms,root)
call psb_bcast(ctxt,dat%aggr_omega_val,root) call psb_bcast(ctxt,dat%aggr_omega_val,root)
@@ -1240,7 +1244,7 @@ contains
implicit none implicit none
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
type(amg_dml_parms), intent(inout) :: dat type(amg_dml_parms), intent(inout) :: dat
integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_), intent(in), optional :: root
call psb_bcast(ctxt,dat%amg_ml_parms,root) call psb_bcast(ctxt,dat%amg_ml_parms,root)
call psb_bcast(ctxt,dat%aggr_omega_val,root) call psb_bcast(ctxt,dat%aggr_omega_val,root)
+3 -6
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -62,9 +62,6 @@ module amg_c_ainv_solver
procedure, pass(sv) :: cseti => amg_c_ainv_solver_cseti procedure, pass(sv) :: cseti => amg_c_ainv_solver_cseti
procedure, pass(sv) :: csetc => amg_c_ainv_solver_csetc procedure, pass(sv) :: csetc => amg_c_ainv_solver_csetc
procedure, pass(sv) :: csetr => amg_c_ainv_solver_csetr procedure, pass(sv) :: csetr => amg_c_ainv_solver_csetr
!!$ procedure, pass(sv) :: seti => amg_c_ainv_solver_seti
!!$ procedure, pass(sv) :: setc => amg_c_ainv_solver_setc
!!$ procedure, pass(sv) :: setr => amg_c_ainv_solver_setr
procedure, pass(sv) :: descr => amg_c_ainv_solver_descr procedure, pass(sv) :: descr => amg_c_ainv_solver_descr
procedure, pass(sv) :: default => c_ainv_solver_default procedure, pass(sv) :: default => c_ainv_solver_default
procedure, nopass :: stringval => c_ainv_stringval procedure, nopass :: stringval => c_ainv_stringval
@@ -106,7 +103,7 @@ module amg_c_ainv_solver
Implicit None Implicit None
! Arguments ! Arguments
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_ainv_solver_type), intent(inout) :: sv class(amg_c_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -228,7 +225,7 @@ module amg_c_ainv_solver
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_d_vect_type, psb_c_base_vect_type, psb_spk_, psb_ipk_ & psb_d_vect_type, psb_c_base_vect_type, psb_spk_, psb_ipk_
implicit none implicit none
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
integer(psb_ipk_), intent(in) :: fillin,alg integer(psb_ipk_), intent(in) :: fillin,alg
real(psb_spk_), intent(in) :: thresh real(psb_spk_), intent(in) :: thresh
type(psb_cspmat_type), intent(inout) :: wmat, zmat type(psb_cspmat_type), intent(inout) :: wmat, zmat
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -230,7 +230,7 @@ module amg_c_as_smoother
& psb_desc_type, psb_c_base_sparse_mat, psb_ipk_,& & psb_desc_type, psb_c_base_sparse_mat, psb_ipk_,&
& psb_i_base_vect_type & psb_i_base_vect_type
implicit none implicit none
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_as_smoother_type), intent(inout) :: sm class(amg_c_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+8 -8
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -89,7 +89,7 @@ module amg_c_base_aggregator_mod
procedure, pass(ag) :: bld_tprol => amg_c_base_aggregator_build_tprol procedure, pass(ag) :: bld_tprol => amg_c_base_aggregator_build_tprol
procedure, pass(ag) :: mat_bld => amg_c_base_aggregator_mat_bld procedure, pass(ag) :: mat_bld => amg_c_base_aggregator_mat_bld
procedure, pass(ag) :: mat_asb => amg_c_base_aggregator_mat_asb procedure, pass(ag) :: mat_asb => amg_c_base_aggregator_mat_asb
procedure, pass(ag) :: bld_map => amg_c_base_aggregator_bld_map procedure, pass(ag) :: bld_linmap => amg_c_base_aggregator_bld_linmap
procedure, pass(ag) :: update_next => amg_c_base_aggregator_update_next procedure, pass(ag) :: update_next => amg_c_base_aggregator_update_next
procedure, pass(ag) :: clone => amg_c_base_aggregator_clone procedure, pass(ag) :: clone => amg_c_base_aggregator_clone
procedure, pass(ag) :: free => amg_c_base_aggregator_free procedure, pass(ag) :: free => amg_c_base_aggregator_free
@@ -302,7 +302,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Do nothing ! Do nothing
info = psb_success_
return return
end subroutine amg_c_base_aggregator_set_aggr_type end subroutine amg_c_base_aggregator_set_aggr_type
@@ -458,7 +458,7 @@ contains
end subroutine amg_c_base_aggregator_mat_asb end subroutine amg_c_base_aggregator_mat_asb
! !
!> Function bld_map !> Function bld_linmap
!! \memberof amg_c_base_aggregator_type !! \memberof amg_c_base_aggregator_type
!! \brief Build linear map between hierarchy levels !! \brief Build linear map between hierarchy levels
!! !!
@@ -473,7 +473,7 @@ contains
!! \param map The output map !! \param map The output map
!! \param info Return code !! \param info Return code
!! !!
subroutine amg_c_base_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,& subroutine amg_c_base_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
& op_restr,op_prol,map,info) & op_restr,op_prol,map,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
@@ -484,8 +484,9 @@ contains
type(psb_clinmap_type), intent(out) :: map type(psb_clinmap_type), intent(out) :: map
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='c_base_aggregator_bld_map' character(len=20) :: name='c_base_aggregator_bld_linmap'
info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! !
! Copy the prolongation/restriction matrices into the descriptor map. ! Copy the prolongation/restriction matrices into the descriptor map.
@@ -507,7 +508,6 @@ contains
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine amg_c_base_aggregator_bld_map end subroutine amg_c_base_aggregator_bld_linmap
end module amg_c_base_aggregator_mod end module amg_c_base_aggregator_mod
+1 -1
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -237,7 +237,7 @@ module amg_c_base_smoother_mod
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_base_smoother_type, psb_ipk_, psb_i_base_vect_type & amg_c_base_smoother_type, psb_ipk_, psb_i_base_vect_type
! Arguments ! Arguments
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_base_smoother_type), intent(inout) :: sm class(amg_c_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -170,7 +170,7 @@ module amg_c_base_solver_mod
Implicit None Implicit None
! Arguments ! Arguments
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_base_solver_type), intent(inout) :: sv class(amg_c_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+3 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -150,7 +150,7 @@ contains
class(amg_c_dec_aggregator_type), intent(inout) :: ag class(amg_c_dec_aggregator_type), intent(inout) :: ag
type(amg_sml_parms), intent(in) :: parms type(amg_sml_parms), intent(in) :: parms
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_
select case(parms%aggr_type) select case(parms%aggr_type)
case (amg_noalg_) case (amg_noalg_)
ag%soc_map_bld => null() ag%soc_map_bld => null()
@@ -192,6 +192,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_ character(1024) :: prefix_
info = psb_success_
if (present(prefix)) then if (present(prefix)) then
prefix_ = prefix prefix_ = prefix
else else
+3 -3
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -119,7 +119,7 @@ module amg_c_diag_solver
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_diag_solver_type, psb_ipk_, psb_i_base_vect_type & amg_c_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_diag_solver_type), intent(inout) :: sv class(amg_c_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -331,7 +331,7 @@ module amg_c_l1_diag_solver
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type & amg_c_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_l1_diag_solver_type), intent(inout) :: sv class(amg_c_l1_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -181,7 +181,7 @@ module amg_c_gs_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,& & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_gs_solver_type), intent(inout) :: sv class(amg_c_gs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -195,7 +195,7 @@ module amg_c_gs_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,& & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_bwgs_solver_type), intent(inout) :: sv class(amg_c_bwgs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
-125
View File
@@ -1,125 +0,0 @@
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. 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.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific 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 THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
! 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.
!
!
!
!
! The aggregator object hosts the aggregation method for building
! the multilevel hierarchy. This variant is based on the hybrid method
! presented in
!
! S. Gratton, P. Henon, P. Jiranek and X. Vasseur:
! Reducing complexity of algebraic multigrid by aggregation
! Numerical Lin. Algebra with Applications, 2016, 23:501-518
!
module amg_c_hybrid_aggregator_mod
use amg_c_dec_aggregator_mod
!
! sm - class(amg_T_base_smoother_type), allocatable
! The current level preconditioner (aka smoother).
! parms - type(amg_RTml_parms)
! The parameters defining the multilevel strategy.
! ac - The local part of the current-level matrix, built by
! coarsening the previous-level matrix.
! desc_ac - type(psb_desc_type).
! The communication descriptor associated to the matrix
! stored in ac.
! base_a - type(psb_Tspmat_type), pointer.
! Pointer (really a pointer!) to the local part of the current
! matrix (so we have a unified treatment of residuals).
! We need this to avoid passing explicitly the current matrix
! to the routine which applies the preconditioner.
! base_desc - type(psb_desc_type), pointer.
! Pointer to the communication descriptor associated to the
! matrix pointed by base_a.
! map - Stores the maps (restriction and prolongation) between the
! vector spaces associated to the index spaces of the previous
! and current levels.
!
! Methods:
! Most methods follow the encapsulation hierarchy: they take whatever action
! is appropriate for the current object, then call the corresponding method for
! the contained object.
! As an example: the descr() method prints out a description of the
! level. It starts by invoking the descr() method of the parms object,
! then calls the descr() method of the smoother object.
!
! descr - Prints a description of the object.
! default - Set default values
! dump - Dump to file object contents
! set - Sets various parameters; when a request is unknown
! it is passed to the smoother object for further processing.
! check - Sanity checks.
! sizeof - Total memory occupation in bytes
! get_nzeros - Number of nonzeros
!
!
type, extends(amg_c_dec_aggregator_type) :: amg_c_hybrid_aggregator_type
contains
procedure, pass(ag) :: bld_tprol => amg_c_hybrid_aggregator_build_tprol
procedure, nopass :: fmt => amg_c_hybrid_aggregator_fmt
end type amg_c_hybrid_aggregator_type
interface
subroutine amg_c_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
import :: amg_c_hybrid_aggregator_type, psb_desc_type, psb_cspmat_type, psb_spk_, &
& psb_ipk_, psb_long_int_k_, amg_sml_parms
implicit none
class(amg_c_hybrid_aggregator_type), target, intent(inout) :: ag
type(amg_sml_parms), intent(inout) :: parms
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
type(psb_cspmat_type), intent(out) :: op_prol
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_hybrid_aggregator_build_tprol
end interface
contains
function amg_c_hybrid_aggregator_fmt() result(val)
implicit none
character(len=32) :: val
val = "Hybrid Decoupled aggregation"
end function amg_c_hybrid_aggregator_fmt
end module amg_c_hybrid_aggregator_mod
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -123,7 +123,7 @@ contains
Implicit None Implicit None
! Arguments ! Arguments
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_id_solver_type), intent(inout) :: sv class(amg_c_id_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+1 -1
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -144,7 +144,7 @@ module amg_c_ilu_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,& & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_ilu_solver_type), intent(inout) :: sv class(amg_c_ilu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+4 -4
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -56,7 +56,7 @@ module amg_c_inner_mod
& psb_spk_, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_ & psb_spk_, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
import :: amg_cprec_type import :: amg_cprec_type
implicit none implicit none
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
type(amg_cprec_type), intent(inout), target :: prec type(amg_cprec_type), intent(inout), target :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -67,7 +67,7 @@ module amg_c_inner_mod
end interface amg_mlprec_bld end interface amg_mlprec_bld
interface amg_mlprec_aply interface amg_mlprec_aply
subroutine amg_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) subroutine amg_cmlprec_aply_a(alpha,p,x,beta,y,desc_data,trans,work,info)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_ import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
import :: amg_cprec_type import :: amg_cprec_type
implicit none implicit none
@@ -79,7 +79,7 @@ module amg_c_inner_mod
character,intent(in) :: trans character,intent(in) :: trans
complex(psb_spk_),target :: work(:) complex(psb_spk_),target :: work(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine amg_cmlprec_aply end subroutine amg_cmlprec_aply_a
subroutine amg_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) subroutine amg_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
import :: psb_cspmat_type, psb_desc_type, & import :: psb_cspmat_type, psb_desc_type, &
& psb_spk_, psb_c_vect_type, psb_ipk_ & psb_spk_, psb_c_vect_type, psb_ipk_
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -94,7 +94,7 @@ module amg_c_invk_solver
Implicit None Implicit None
! Arguments ! Arguments
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_invk_solver_type), intent(inout) :: sv class(amg_c_invk_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -94,7 +94,7 @@ module amg_c_invt_solver
Implicit None Implicit None
! Arguments ! Arguments
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_invt_solver_type), intent(inout) :: sv class(amg_c_invt_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -151,7 +151,7 @@ module amg_c_jac_smoother
import :: psb_desc_type, amg_c_jac_smoother_type, psb_c_vect_type, psb_spk_, & import :: psb_desc_type, amg_c_jac_smoother_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,& & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_jac_smoother_type), intent(inout) :: sm class(amg_c_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -274,7 +274,7 @@ module amg_c_jac_smoother
import :: psb_desc_type, amg_c_l1_jac_smoother_type, psb_c_vect_type, & import :: psb_desc_type, amg_c_l1_jac_smoother_type, psb_c_vect_type, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,& & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_l1_jac_smoother_type), intent(inout) :: sm class(amg_c_l1_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -143,7 +143,7 @@ module amg_c_jac_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,& & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_jac_solver_type), intent(inout) :: sv class(amg_c_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -160,7 +160,7 @@ module amg_c_jac_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,& & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_l1_jac_solver_type), intent(inout) :: sv class(amg_c_l1_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -23,7 +23,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -57,7 +57,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -174,7 +174,7 @@ module amg_c_krm_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,& & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_krm_solver_type), intent(inout) :: sv class(amg_c_krm_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+13 -13
View File
@@ -21,7 +21,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -52,10 +52,10 @@
! !
module amg_c_mumps_solver module amg_c_mumps_solver
use amg_c_base_solver_mod use amg_c_base_solver_mod
#if defined(HAVE_MUMPS_) && defined(HAVE_MUMPS_MODULES_) #if defined(AMG_HAVE_MUMPS) && defined(AMG_HAVE_MUMPS_MODULES)
use cmumps_struc_def use cmumps_struc_def
#endif #endif
#if defined(HAVE_MUMPS_) && defined(HAVE_MUMPS_INCLUDES_) #if defined(AMG_HAVE_MUMPS) && defined(AMG_HAVE_MUMPS_INCLUDES)
include 'cmumps_struc.h' include 'cmumps_struc.h'
#endif #endif
@@ -68,7 +68,7 @@ module amg_c_mumps_solver
end type amg_c_mumps_rcntl_item end type amg_c_mumps_rcntl_item
type, extends(amg_c_base_solver_type) :: amg_c_mumps_solver_type type, extends(amg_c_base_solver_type) :: amg_c_mumps_solver_type
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
type(cmumps_struc), allocatable :: id type(cmumps_struc), allocatable :: id
#else #else
integer, allocatable :: id integer, allocatable :: id
@@ -163,7 +163,7 @@ module amg_c_mumps_solver
Implicit None Implicit None
! Arguments ! Arguments
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_mumps_solver_type), intent(inout) :: sv class(amg_c_mumps_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -189,7 +189,7 @@ contains
info = 0 info = 0
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@@ -239,7 +239,7 @@ contains
character(len=20) :: name='c_mumps_solver_clear_data' character(len=20) :: name='c_mumps_solver_clear_data'
info = 0 info = 0
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (allocated(sv%id)) then if (allocated(sv%id)) then
if (sv%built) then if (sv%built) then
@@ -279,7 +279,7 @@ contains
character(len=20) :: name='c_mumps_solver_free' character(len=20) :: name='c_mumps_solver_free'
info = 0 info = 0
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call sv%clear_data(info) call sv%clear_data(info)
if ((info == 0).and.allocated(sv%icntl)) deallocate(sv%icntl,stat=info) if ((info == 0).and.allocated(sv%icntl)) deallocate(sv%icntl,stat=info)
@@ -383,7 +383,7 @@ subroutine c_mumps_solver_csetc(sv,what,val,info,idx)
select case(psb_toupper(trim(what))) select case(psb_toupper(trim(what)))
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
case('MUMPS_LOC_GLOB') case('MUMPS_LOC_GLOB')
sv%ipar(1) = sv%stringval(psb_toupper(trim(val))) sv%ipar(1) = sv%stringval(psb_toupper(trim(val)))
#endif #endif
@@ -421,7 +421,7 @@ subroutine c_mumps_solver_cseti(sv,what,val,info,idx)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
select case(psb_toupper(what)) select case(psb_toupper(what))
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
case('MUMPS_LOC_GLOB') case('MUMPS_LOC_GLOB')
sv%ipar(1) = val sv%ipar(1) = val
case('MUMPS_PRINT_ERR') case('MUMPS_PRINT_ERR')
@@ -467,7 +467,7 @@ subroutine c_mumps_solver_csetr(sv,what,val,info,idx)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
select case(psb_toupper(what)) select case(psb_toupper(what))
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
case('MUMPS_RPAR_ENTRY') case('MUMPS_RPAR_ENTRY')
if(present(idx)) then if(present(idx)) then
! Note: this will allocate %item ! Note: this will allocate %item
@@ -504,7 +504,7 @@ subroutine c_mumps_solver_default(sv)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
if (.not.allocated(sv%id)) then if (.not.allocated(sv%id)) then
allocate(sv%id,stat=info) allocate(sv%id,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
@@ -561,7 +561,7 @@ function c_mumps_solver_sizeof(sv) result(val)
class(amg_c_mumps_solver_type), intent(in) :: sv class(amg_c_mumps_solver_type), intent(in) :: sv
integer(psb_epk_) :: val integer(psb_epk_) :: val
integer :: i integer :: i
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
val = (sv%id%INFOG(22)+sv%id%INFOG(32))*1d+6 val = (sv%id%INFOG(22)+sv%id%INFOG(32))*1d+6
#else #else
val = 0 val = 0
+161 -376
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -154,13 +154,35 @@ module amg_c_onelev_mod
private :: c_wrk_alloc, c_wrk_free, & private :: c_wrk_alloc, c_wrk_free, &
& c_wrk_clone, c_wrk_move_alloc, c_wrk_cnv, c_wrk_sizeof & c_wrk_clone, c_wrk_move_alloc, c_wrk_cnv, c_wrk_sizeof
!
! Remap.
! This keeps track of remapping.
! Logic here is as follows:
! 1. AC_PRE_REMAP need to figure out if we
! really need it.
! 2. DESC_AC_PRE_REMAP contains the descriptor before
! remapping. Meaning that it is possible
! to implement the RESTRICTOR operator by
! a. Doing LINMAP_U2V onto this one
! b. For each process, send the data to
! IDEST.
! This assumes that remapping goes by
! a factor of 2.
! For the PROLONGATOR operators, we first
! use DESC_AC, then split and send onto
! the processes in DESC_AC_PRE_REMAP.
!
! To be fixed: what happens if NP the starting processes
! is not an even number? Coordinate with _X_remap in PSBLAS
!
type amg_c_remap_data_type type amg_c_remap_data_type
type(psb_cspmat_type) :: ac_pre_remap type(psb_cspmat_type) :: ac_pre_remap
type(psb_desc_type) :: desc_ac_pre_remap type(psb_desc_type) :: desc_ac_pre_remap
integer(psb_ipk_) :: idest integer(psb_ipk_) :: idest
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:) integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
contains contains
procedure, pass(rmp) :: clone => c_remap_data_clone procedure, pass(rmp) :: clone => c_remap_data_clone
procedure, pass(rmp) :: move_alloc => c_remap_move_alloc
end type amg_c_remap_data_type end type amg_c_remap_data_type
type amg_c_onelev_type type amg_c_onelev_type
@@ -206,7 +228,7 @@ module amg_c_onelev_mod
procedure, pass(lv) :: get_wrksz => c_base_onelev_get_wrksize procedure, pass(lv) :: get_wrksz => c_base_onelev_get_wrksize
procedure, pass(lv) :: allocate_wrk => c_base_onelev_allocate_wrk procedure, pass(lv) :: allocate_wrk => c_base_onelev_allocate_wrk
procedure, pass(lv) :: free_wrk => c_base_onelev_free_wrk procedure, pass(lv) :: free_wrk => c_base_onelev_free_wrk
procedure, nopass :: stringval => amg_stringval procedure, nopass :: stringval => amg_stringval
procedure, pass(lv) :: move_alloc => c_base_onelev_move_alloc procedure, pass(lv) :: move_alloc => c_base_onelev_move_alloc
@@ -230,9 +252,7 @@ module amg_c_onelev_mod
& c_base_onelev_free_wrk & c_base_onelev_free_wrk
interface interface
subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) module subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lcspmat_type, psb_lpk_
import :: amg_c_onelev_type
implicit none implicit none
class(amg_c_onelev_type), intent(inout), target :: lv class(amg_c_onelev_type), intent(inout), target :: lv
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
@@ -244,10 +264,7 @@ module amg_c_onelev_mod
end interface end interface
interface interface
subroutine amg_c_base_onelev_build(lv,info,amold,vmold,imold,ilv) module subroutine amg_c_base_onelev_build(lv,info,amold,vmold,imold,ilv)
import :: psb_c_base_sparse_mat, psb_c_base_vect_type, &
& psb_i_base_vect_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv class(amg_c_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -259,10 +276,7 @@ module amg_c_onelev_mod
end interface end interface
interface interface
subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix) module subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments ! Arguments
class(amg_c_onelev_type), intent(in) :: lv class(amg_c_onelev_type), intent(in) :: lv
@@ -275,10 +289,8 @@ module amg_c_onelev_mod
end interface end interface
interface interface
subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global) module subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,&
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & & iout,verbosity, prefix,global)
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments ! Arguments
class(amg_c_onelev_type), intent(in) :: lv class(amg_c_onelev_type), intent(in) :: lv
@@ -292,10 +304,7 @@ module amg_c_onelev_mod
end interface end interface
interface interface
subroutine amg_c_base_onelev_cnv(lv,info,amold,vmold,imold) module subroutine amg_c_base_onelev_cnv(lv,info,amold,vmold,imold)
import :: amg_c_onelev_type, psb_c_base_vect_type, psb_spk_, &
& psb_c_base_sparse_mat, psb_ipk_, psb_i_base_vect_type
! Arguments
class(amg_c_onelev_type), intent(inout) :: lv class(amg_c_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_sparse_mat), intent(in), optional :: amold
@@ -305,48 +314,32 @@ module amg_c_onelev_mod
end interface end interface
interface interface
subroutine amg_c_base_onelev_free(lv,info) module subroutine amg_c_base_onelev_free(lv,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none implicit none
class(amg_c_onelev_type), intent(inout) :: lv class(amg_c_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_base_onelev_free end subroutine amg_c_base_onelev_free
end interface end interface
interface interface
subroutine amg_c_base_onelev_free_smoothers(lv,info) module subroutine amg_c_base_onelev_free_smoothers(lv,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none implicit none
class(amg_c_onelev_type), intent(inout) :: lv class(amg_c_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_base_onelev_free_smoothers end subroutine amg_c_base_onelev_free_smoothers
end interface end interface
interface interface
subroutine amg_c_base_onelev_check(lv,info) module subroutine amg_c_base_onelev_check(lv,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_c_onelev_type), intent(inout) :: lv class(amg_c_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_base_onelev_check end subroutine amg_c_base_onelev_check
end interface end interface
interface interface
subroutine amg_c_base_onelev_setsm(lv,val,info,pos) module subroutine amg_c_base_onelev_setsm(lv,val,info,pos)
import :: psb_spk_, amg_c_onelev_type, amg_c_base_smoother_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_c_onelev_type), target, intent(inout) :: lv class(amg_c_onelev_type), target, intent(inout) :: lv
class(amg_c_base_smoother_type), intent(in) :: val class(amg_c_base_smoother_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -355,12 +348,8 @@ module amg_c_onelev_mod
end interface end interface
interface interface
subroutine amg_c_base_onelev_setsv(lv,val,info,pos) module subroutine amg_c_base_onelev_setsv(lv,val,info,pos)
import :: psb_spk_, amg_c_onelev_type, amg_c_base_solver_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_c_onelev_type), target, intent(inout) :: lv class(amg_c_onelev_type), target, intent(inout) :: lv
class(amg_c_base_solver_type), intent(in) :: val class(amg_c_base_solver_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -369,12 +358,8 @@ module amg_c_onelev_mod
end interface end interface
interface interface
subroutine amg_c_base_onelev_setag(lv,val,info,pos) module subroutine amg_c_base_onelev_setag(lv,val,info,pos)
import :: psb_spk_, amg_c_onelev_type, amg_c_base_aggregator_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_c_onelev_type), target, intent(inout) :: lv class(amg_c_onelev_type), target, intent(inout) :: lv
class(amg_c_base_aggregator_type), intent(in) :: val class(amg_c_base_aggregator_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -383,13 +368,8 @@ module amg_c_onelev_mod
end interface end interface
interface interface
subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx) module subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_c_onelev_type), intent(inout) :: lv class(amg_c_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(in) :: val
@@ -400,12 +380,8 @@ module amg_c_onelev_mod
end interface end interface
interface interface
subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx) module subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_c_onelev_type), intent(inout) :: lv class(amg_c_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what character(len=*), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
@@ -416,12 +392,8 @@ module amg_c_onelev_mod
end interface end interface
interface interface
subroutine amg_c_base_onelev_csetr(lv,what,val,info,pos,idx) module subroutine amg_c_base_onelev_csetr(lv,what,val,info,pos,idx)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
class(amg_c_onelev_type), intent(inout) :: lv class(amg_c_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
@@ -432,11 +404,8 @@ module amg_c_onelev_mod
end interface end interface
interface interface
subroutine amg_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,& module subroutine amg_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
& solver,tprol,global_num) & solver,tprol,global_num)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none implicit none
class(amg_c_onelev_type), intent(in) :: lv class(amg_c_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
@@ -447,8 +416,7 @@ module amg_c_onelev_mod
end interface end interface
interface interface
subroutine amg_c_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work) module subroutine amg_c_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
import
implicit none implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv class(amg_c_onelev_type), target, intent(inout) :: lv
complex(psb_spk_), intent(in) :: alpha, beta complex(psb_spk_), intent(in) :: alpha, beta
@@ -457,8 +425,8 @@ module amg_c_onelev_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
complex(psb_spk_), optional :: work(:) complex(psb_spk_), optional :: work(:)
end subroutine amg_c_base_onelev_map_rstr_a end subroutine amg_c_base_onelev_map_rstr_a
subroutine amg_c_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty) module subroutine amg_c_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
import & work,vtx,vty)
implicit none implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv class(amg_c_onelev_type), target, intent(inout) :: lv
complex(psb_spk_), intent(in) :: alpha, beta complex(psb_spk_), intent(in) :: alpha, beta
@@ -470,8 +438,7 @@ module amg_c_onelev_mod
end interface end interface
interface interface
subroutine amg_c_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work) module subroutine amg_c_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
import
implicit none implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv class(amg_c_onelev_type), target, intent(inout) :: lv
complex(psb_spk_), intent(in) :: alpha, beta complex(psb_spk_), intent(in) :: alpha, beta
@@ -481,8 +448,8 @@ module amg_c_onelev_mod
complex(psb_spk_), optional :: work(:) complex(psb_spk_), optional :: work(:)
end subroutine amg_c_base_onelev_map_prol_a end subroutine amg_c_base_onelev_map_prol_a
subroutine amg_c_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty) module subroutine amg_c_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,&
import & work,vtx,vty)
implicit none implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv class(amg_c_onelev_type), target, intent(inout) :: lv
complex(psb_spk_), intent(in) :: alpha, beta complex(psb_spk_), intent(in) :: alpha, beta
@@ -493,6 +460,118 @@ module amg_c_onelev_mod
end subroutine amg_c_base_onelev_map_prol_v end subroutine amg_c_base_onelev_map_prol_v
end interface end interface
interface
module subroutine c_base_onelev_move_alloc(lv, b,info)
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv, b
integer(psb_ipk_), intent(out) :: info
end subroutine c_base_onelev_move_alloc
end interface
interface
module subroutine c_base_onelev_allocate_wrk(lv,info,vmold)
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold
end subroutine c_base_onelev_allocate_wrk
end interface
interface
module subroutine c_base_onelev_free_wrk(lv,info)
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine c_base_onelev_free_wrk
end interface
interface
module subroutine c_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
Implicit None
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold
type(psb_desc_type), intent(in), optional :: desc2
end subroutine c_wrk_alloc
end interface
interface
module subroutine c_inner_do_wrk_alloc(wk,nwv,desc,vmold)
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
class(psb_c_base_vect_type), intent(in), optional :: vmold
end subroutine c_inner_do_wrk_alloc
end interface
interface
module subroutine c_wrk_free(wk,info)
Implicit None
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
end subroutine c_wrk_free
end interface
interface
module subroutine c_wrk_clone(wk,wkout,info)
Implicit None
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
class(amg_cmlprec_wrk_type), target, intent(inout) :: wkout
integer(psb_ipk_), intent(out) :: info
end subroutine c_wrk_clone
end interface
interface
module subroutine c_wrk_move_alloc(wk, b,info)
implicit none
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk, b
integer(psb_ipk_), intent(out) :: info
end subroutine c_wrk_move_alloc
end interface
interface
module subroutine c_wrk_cnv(wk,info,vmold)
Implicit None
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold
end subroutine c_wrk_cnv
end interface
interface
module function c_wrk_sizeof(wk) result(val)
implicit none
class(amg_cmlprec_wrk_type), intent(in) :: wk
integer(psb_epk_) :: val
end function c_wrk_sizeof
end interface
interface
module subroutine c_remap_data_clone(rmp, remap_out, info)
implicit none
! Arguments
class(amg_c_remap_data_type), target, intent(inout) :: rmp
class(amg_c_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
end subroutine c_remap_data_clone
end interface
interface
module subroutine c_remap_move_alloc(rmp, remap_out, info)
implicit none
! Arguments
class(amg_c_remap_data_type), target, intent(inout) :: rmp
class(amg_c_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
end subroutine c_remap_move_alloc
end interface
contains contains
! !
! Function returning the size of the amg_prec_type data structure ! Function returning the size of the amg_prec_type data structure
@@ -618,7 +697,7 @@ contains
! Arguments ! Arguments
class(amg_c_onelev_type), target, intent(inout) :: lv class(amg_c_onelev_type), target, intent(inout) :: lv
class(amg_c_onelev_type), target, intent(inout) :: lvout class(amg_c_onelev_type), target, intent(inout) :: lvout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_ info = psb_success_
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
@@ -660,36 +739,6 @@ contains
end subroutine c_base_onelev_clone end subroutine c_base_onelev_clone
subroutine c_base_onelev_move_alloc(lv, b,info)
use psb_base_mod
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv, b
integer(psb_ipk_), intent(out) :: info
call b%free(info)
b%parms = lv%parms
b%szratio = lv%szratio
if (associated(lv%sm2,lv%sm2a)) then
call move_alloc(lv%sm,b%sm)
call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm2a
else
call move_alloc(lv%sm,b%sm)
call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm
end if
call move_alloc(lv%aggr,b%aggr)
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
b%base_a => lv%base_a
b%base_desc => lv%base_desc
end subroutine c_base_onelev_move_alloc
function c_base_onelev_get_wrksize(lv) result(val) function c_base_onelev_get_wrksize(lv) result(val)
implicit none implicit none
class(amg_c_onelev_type), intent(inout) :: lv class(amg_c_onelev_type), intent(inout) :: lv
@@ -727,269 +776,5 @@ contains
end function c_base_onelev_get_wrksize end function c_base_onelev_get_wrksize
subroutine c_base_onelev_allocate_wrk(lv,info,vmold)
use psb_base_mod
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: nwv, i
info = psb_success_
nwv = lv%get_wrksz()
if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
if (info == 0) then
if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
!
! Need to fix this, we need two different allocations
!
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold,&
& desc2=lv%remap_data%desc_ac_pre_remap)
else
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
end if
end if
end subroutine c_base_onelev_allocate_wrk
subroutine c_base_onelev_free_wrk(lv,info)
use psb_base_mod
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: nwv,i
info = psb_success_
if (allocated(lv%wrk)) then
call lv%wrk%free(info)
if (info == 0) deallocate(lv%wrk,stat=info)
end if
end subroutine c_base_onelev_free_wrk
subroutine c_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
use psb_base_mod
Implicit None
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold
type(psb_desc_type), intent(in), optional :: desc2
!
integer(psb_ipk_) :: i
info = psb_success_
call wk%free(info)
if (present(desc2)) then
!!$ write(0,*) 'Check on wrk_alloc 2',&
!!$ & desc2%get_local_rows(), desc%get_local_rows(),&
!!$ & desc2%get_local_cols(),desc%get_local_cols()
!!$ flush(0)
if (desc2%get_local_cols()>desc%get_local_cols()) then
call psb_geasb(wk%vx2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc2,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc2,info,&
& scratch=.true.,mold=vmold)
end do
else
!!$ write(0,*) 'Check on wrk_alloc 1.5 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
else
!!$ write(0,*) 'Check on wrk_alloc 1 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
end subroutine c_wrk_alloc
subroutine c_wrk_free(wk,info)
Implicit None
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
if (allocated(wk%tx)) deallocate(wk%tx, stat=info)
if (allocated(wk%ty)) deallocate(wk%ty, stat=info)
if (allocated(wk%x2l)) deallocate(wk%x2l, stat=info)
if (allocated(wk%y2l)) deallocate(wk%y2l, stat=info)
call wk%vtx%free(info)
call wk%vty%free(info)
call wk%vx2l%free(info)
call wk%vy2l%free(info)
if (allocated(wk%wv)) then
do i=1,size(wk%wv)
call wk%wv(i)%free(info)
end do
deallocate(wk%wv, stat=info)
end if
end subroutine c_wrk_free
subroutine c_wrk_clone(wk,wkout,info)
use psb_base_mod
Implicit None
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
class(amg_cmlprec_wrk_type), target, intent(inout) :: wkout
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call psb_safe_ab_cpy(wk%tx,wkout%tx,info)
call psb_safe_ab_cpy(wk%ty,wkout%ty,info)
call psb_safe_ab_cpy(wk%x2l,wkout%x2l,info)
call psb_safe_ab_cpy(wk%y2l,wkout%y2l,info)
call wk%vtx%clone(wkout%vtx,info)
call wk%vty%clone(wkout%vty,info)
call wk%vx2l%clone(wkout%vx2l,info)
call wk%vy2l%clone(wkout%vy2l,info)
if (allocated(wkout%wv)) then
do i=1,size(wkout%wv)
call wkout%wv(i)%free(info)
end do
deallocate( wkout%wv)
end if
allocate(wkout%wv(size(wk%wv)),stat=info)
do i=1,size(wk%wv)
call wk%wv(i)%clone(wkout%wv(i),info)
end do
return
end subroutine c_wrk_clone
subroutine c_wrk_move_alloc(wk, b,info)
implicit none
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk, b
integer(psb_ipk_), intent(out) :: info
call b%free(info)
call move_alloc(wk%tx,b%tx)
call move_alloc(wk%ty,b%ty)
call move_alloc(wk%x2l,b%x2l)
call move_alloc(wk%y2l,b%y2l)
!
! Should define V%move_alloc....
call move_alloc(wk%vtx%v,b%vtx%v)
call move_alloc(wk%vty%v,b%vty%v)
call move_alloc(wk%vx2l%v,b%vx2l%v)
call move_alloc(wk%vy2l%v,b%vy2l%v)
call move_alloc(wk%wv,b%wv)
end subroutine c_wrk_move_alloc
subroutine c_wrk_cnv(wk,info,vmold)
use psb_base_mod
Implicit None
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: i
info = psb_success_
if (present(vmold)) then
call wk%vtx%cnv(vmold)
call wk%vty%cnv(vmold)
call wk%vx2l%cnv(vmold)
call wk%vy2l%cnv(vmold)
if (allocated(wk%wv)) then
do i=1,size(wk%wv)
call wk%wv(i)%cnv(vmold)
end do
end if
end if
end subroutine c_wrk_cnv
function c_wrk_sizeof(wk) result(val)
use psb_realloc_mod
implicit none
class(amg_cmlprec_wrk_type), intent(in) :: wk
integer(psb_epk_) :: val
integer :: i
val = 0
val = val + (1_psb_epk_ * (2*psb_sizeof_sp)) * psb_size(wk%tx)
val = val + (1_psb_epk_ * (2*psb_sizeof_sp)) * psb_size(wk%ty)
val = val + (1_psb_epk_ * (2*psb_sizeof_sp)) * psb_size(wk%x2l)
val = val + (1_psb_epk_ * (2*psb_sizeof_sp)) * psb_size(wk%y2l)
val = val + wk%vtx%sizeof()
val = val + wk%vty%sizeof()
val = val + wk%vx2l%sizeof()
val = val + wk%vy2l%sizeof()
if (allocated(wk%wv)) then
do i=1, size(wk%wv)
val = val + wk%wv(i)%sizeof()
end do
end if
end function c_wrk_sizeof
subroutine c_remap_data_clone(rmp, remap_out, info)
use psb_base_mod
implicit none
! Arguments
class(amg_c_remap_data_type), target, intent(inout) :: rmp
class(amg_c_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
if (info == psb_success_) &
& call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
remap_out%idest = rmp%idest
call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
end subroutine c_remap_data_clone
end module amg_c_onelev_mod end module amg_c_onelev_mod
+1 -1
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+48 -40
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -102,6 +102,7 @@ module amg_c_prec_type
! The multilevel hierarchy ! The multilevel hierarchy
! !
type(amg_c_onelev_type), allocatable :: precv(:) type(amg_c_onelev_type), allocatable :: precv(:)
integer(psb_ipk_) :: nlevs
contains contains
procedure, pass(prec) :: psb_c_apply2_vect => amg_c_apply2_vect procedure, pass(prec) :: psb_c_apply2_vect => amg_c_apply2_vect
procedure, pass(prec) :: psb_c_apply1_vect => amg_c_apply1_vect procedure, pass(prec) :: psb_c_apply1_vect => amg_c_apply1_vect
@@ -113,11 +114,13 @@ module amg_c_prec_type
procedure, pass(prec) :: free => amg_c_prec_free procedure, pass(prec) :: free => amg_c_prec_free
procedure, pass(prec) :: allocate_wrk => amg_c_allocate_wrk procedure, pass(prec) :: allocate_wrk => amg_c_allocate_wrk
procedure, pass(prec) :: free_wrk => amg_c_free_wrk procedure, pass(prec) :: free_wrk => amg_c_free_wrk
procedure, pass(prec) :: deallocate_wrk => amg_c_free_wrk
procedure, pass(prec) :: is_allocated_wrk => amg_c_is_allocated_wrk procedure, pass(prec) :: is_allocated_wrk => amg_c_is_allocated_wrk
procedure, pass(prec) :: get_complexity => amg_c_get_compl procedure, pass(prec) :: get_complexity => amg_c_get_compl
procedure, pass(prec) :: cmp_complexity => amg_c_cmp_compl procedure, pass(prec) :: cmp_complexity => amg_c_cmp_compl
procedure, pass(prec) :: get_avg_cr => amg_c_get_avg_cr procedure, pass(prec) :: get_avg_cr => amg_c_get_avg_cr
procedure, pass(prec) :: cmp_avg_cr => amg_c_cmp_avg_cr procedure, pass(prec) :: cmp_avg_cr => amg_c_cmp_avg_cr
procedure, pass(prec) :: set_nlevs => amg_c_set_nlevs
procedure, pass(prec) :: get_nlevs => amg_c_get_nlevs procedure, pass(prec) :: get_nlevs => amg_c_get_nlevs
procedure, pass(prec) :: get_nzeros => amg_c_get_nzeros procedure, pass(prec) :: get_nzeros => amg_c_get_nzeros
procedure, pass(prec) :: sizeof => amg_cprec_sizeof procedure, pass(prec) :: sizeof => amg_cprec_sizeof
@@ -310,7 +313,7 @@ module amg_c_prec_type
& psb_c_base_sparse_mat, psb_c_base_vect_type, & & psb_c_base_sparse_mat, psb_c_base_vect_type, &
& psb_i_base_vect_type, amg_cprec_type, psb_ipk_ & psb_i_base_vect_type, amg_cprec_type, psb_ipk_
implicit none implicit none
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
class(amg_cprec_type), intent(inout), target :: prec class(amg_cprec_type), intent(inout), target :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -322,14 +325,15 @@ module amg_c_prec_type
end interface amg_precbld end interface amg_precbld
interface amg_hierarchy_bld interface amg_hierarchy_bld
subroutine amg_c_hierarchy_bld(a,desc_a,prec,info) subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, & import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& amg_cprec_type, psb_ipk_ & amg_cprec_type, psb_ipk_
implicit none implicit none
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
class(amg_cprec_type), intent(inout), target :: prec class(amg_cprec_type), intent(inout), target :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: cpymat
! character, intent(in),optional :: upd ! character, intent(in),optional :: upd
end subroutine amg_c_hierarchy_bld end subroutine amg_c_hierarchy_bld
end interface amg_hierarchy_bld end interface amg_hierarchy_bld
@@ -433,10 +437,19 @@ contains
class(amg_cprec_type), intent(in) :: prec class(amg_cprec_type), intent(in) :: prec
integer(psb_ipk_) :: val integer(psb_ipk_) :: val
val = 0 val = 0
if (allocated(prec%precv)) then !!$ if (allocated(prec%precv)) then
val = size(prec%precv) !!$ val = size(prec%precv)
end if !!$ end if
val = prec%nlevs
!!$ write(0,*) ' NLEVS: ',prec%nlevs, val,size(prec%precv)
end function amg_c_get_nlevs end function amg_c_get_nlevs
subroutine amg_c_set_nlevs(prec,nl)
implicit none
class(amg_cprec_type), intent(inout) :: prec
integer(psb_ipk_) :: nl
prec%nlevs = nl
end subroutine amg_c_set_nlevs
! !
! Function returning the size of the amg_prec_type data structure ! Function returning the size of the amg_prec_type data structure
! in bytes or in number of nonzeros of the operator(s) involved. ! in bytes or in number of nonzeros of the operator(s) involved.
@@ -507,7 +520,7 @@ contains
real(psb_spk_) :: num, den, nmin real(psb_spk_) :: num, den, nmin
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il integer(psb_ipk_) :: il,nl
num = -sone num = -sone
den = sone den = sone
@@ -517,7 +530,10 @@ contains
num = prec%precv(il)%base_a%get_nzeros() num = prec%precv(il)%base_a%get_nzeros()
if (num >= szero) then if (num >= szero) then
den = num den = num
do il=2,size(prec%precv) nl = prec%get_nlevs()
!!$ write(0,*) 'Inside cmp_compl ',nl,size(prec%precv)
do il=2, nl
!!$ write(0,*) ' ',il,associated(prec%precv(il)%base_a)
num = num + max(0,prec%precv(il)%base_a%get_nzeros()) num = num + max(0,prec%precv(il)%base_a%get_nzeros())
end do end do
end if end if
@@ -548,7 +564,6 @@ contains
end function amg_c_get_avg_cr end function amg_c_get_avg_cr
subroutine amg_c_cmp_avg_cr(prec) subroutine amg_c_cmp_avg_cr(prec)
implicit none implicit none
class(amg_cprec_type), intent(inout) :: prec class(amg_cprec_type), intent(inout) :: prec
@@ -556,17 +571,18 @@ contains
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il, nl, iam, np integer(psb_ipk_) :: il, nl, iam, np
avgcr = szero avgcr = szero
nl = prec%get_nlevs()
do il=2,nl
if (prec%precv(il)%base_desc%is_ok()) then
ctxt = prec%precv(il)%base_desc%get_ctxt()
call psb_info(ctxt,iam,np)
if (iam >=0) avgcr = avgcr + max(szero,prec%precv(il)%szratio)
end if
end do
avgcr = avgcr / (nl-1)
ctxt = prec%ctxt ctxt = prec%ctxt
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
if (allocated(prec%precv)) then
nl = size(prec%precv)
do il=2,nl
avgcr = avgcr + max(szero,prec%precv(il)%szratio)
end do
avgcr = avgcr / (nl-1)
end if
call psb_sum(ctxt,avgcr) call psb_sum(ctxt,avgcr)
prec%ag_data%avg_cr = avgcr/np prec%ag_data%avg_cr = avgcr/np
end subroutine amg_c_cmp_avg_cr end subroutine amg_c_cmp_avg_cr
@@ -584,9 +600,7 @@ contains
! error code. ! error code.
! !
subroutine amg_cprecfree(p,info) subroutine amg_cprecfree(p,info)
implicit none implicit none
! Arguments ! Arguments
type(amg_cprec_type), intent(inout) :: p type(amg_cprec_type), intent(inout) :: p
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -612,9 +626,7 @@ contains
end subroutine amg_cprecfree end subroutine amg_cprecfree
subroutine amg_c_prec_free(prec,info) subroutine amg_c_prec_free(prec,info)
implicit none implicit none
! Arguments ! Arguments
class(amg_cprec_type), intent(inout) :: prec class(amg_cprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -634,6 +646,11 @@ contains
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
do i=1,size(prec%precv) do i=1,size(prec%precv)
call prec%precv(i)%free(info) call prec%precv(i)%free(info)
if (psb_errstatus_fatal()) then
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
end do end do
deallocate(prec%precv,stat=info) deallocate(prec%precv,stat=info)
end if end if
@@ -646,9 +663,7 @@ contains
end subroutine amg_c_prec_free end subroutine amg_c_prec_free
subroutine amg_c_smoothers_free(prec,info) subroutine amg_c_smoothers_free(prec,info)
implicit none implicit none
! Arguments ! Arguments
class(amg_cprec_type), intent(inout) :: prec class(amg_cprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -665,7 +680,7 @@ contains
end if end if
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
do i=1,size(prec%precv) do i=1,prec%get_nlevs()
call prec%precv(i)%free_smoothers(info) call prec%precv(i)%free_smoothers(info)
end do end do
end if end if
@@ -679,9 +694,7 @@ contains
end subroutine amg_c_smoothers_free end subroutine amg_c_smoothers_free
subroutine amg_c_hierarchy_free(prec,info) subroutine amg_c_hierarchy_free(prec,info)
implicit none implicit none
! Arguments ! Arguments
class(amg_cprec_type), intent(inout) :: prec class(amg_cprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -708,7 +721,6 @@ contains
end subroutine amg_c_hierarchy_free end subroutine amg_c_hierarchy_free
! !
! Top level methods. ! Top level methods.
! !
@@ -773,7 +785,6 @@ contains
end subroutine amg_c_apply1_vect end subroutine amg_c_apply1_vect
subroutine amg_c_apply2v(prec,x,y,desc_data,info,trans,work) subroutine amg_c_apply2v(prec,x,y,desc_data,info,trans,work)
implicit none implicit none
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
@@ -838,7 +849,6 @@ contains
subroutine amg_c_dump(prec,info,istart,iend,iproc,prefix,head,& subroutine amg_c_dump(prec,info,istart,iend,iproc,prefix,head,&
& ac,rp,smoother,solver,tprol,& & ac,rp,smoother,solver,tprol,&
& global_num) & global_num)
implicit none implicit none
class(amg_cprec_type), intent(in) :: prec class(amg_cprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -855,7 +865,7 @@ contains
info = 0 info = 0
ctxt = prec%ctxt ctxt = prec%ctxt
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
iln = size(prec%precv) iln = prec%get_nlevs()
if (present(istart)) then if (present(istart)) then
il1 = max(1,istart) il1 = max(1,istart)
else else
@@ -879,7 +889,6 @@ contains
end subroutine amg_c_dump end subroutine amg_c_dump
subroutine amg_c_cnv(prec,info,amold,vmold,imold) subroutine amg_c_cnv(prec,info,amold,vmold,imold)
implicit none implicit none
class(amg_cprec_type), intent(inout) :: prec class(amg_cprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -891,7 +900,7 @@ contains
info = psb_success_ info = psb_success_
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
do i=1,size(prec%precv) do i=1,prec%get_nlevs()
if (info == psb_success_ ) & if (info == psb_success_ ) &
& call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold) & call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold)
end do end do
@@ -900,7 +909,6 @@ contains
end subroutine amg_c_cnv end subroutine amg_c_cnv
subroutine amg_c_clone(prec,precout,info) subroutine amg_c_clone(prec,precout,info)
implicit none implicit none
class(amg_cprec_type), intent(inout) :: prec class(amg_cprec_type), intent(inout) :: prec
class(psb_cprec_type), intent(inout) :: precout class(psb_cprec_type), intent(inout) :: precout
@@ -912,7 +920,6 @@ contains
end subroutine amg_c_clone end subroutine amg_c_clone
subroutine amg_c_inner_clone(prec,precout,info) subroutine amg_c_inner_clone(prec,precout,info)
implicit none implicit none
class(amg_cprec_type), intent(inout) :: prec class(amg_cprec_type), intent(inout) :: prec
class(psb_cprec_type), target, intent(inout) :: precout class(psb_cprec_type), target, intent(inout) :: precout
@@ -928,8 +935,9 @@ contains
pout%ctxt = prec%ctxt pout%ctxt = prec%ctxt
pout%ag_data = prec%ag_data pout%ag_data = prec%ag_data
pout%outer_sweeps = prec%outer_sweeps pout%outer_sweeps = prec%outer_sweeps
pout%nlevs = prec%nlevs
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
ln = size(prec%precv) ln = prec%get_nlevs()
allocate(pout%precv(ln),stat=info) allocate(pout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
if (ln >= 1) then if (ln >= 1) then
@@ -937,6 +945,7 @@ contains
end if end if
do lev=2, ln do lev=2, ln
if (info /= psb_success_) exit if (info /= psb_success_) exit
!!$ write(0,*) 'Inner_clone must be checked and reimplemented! '
call prec%precv(lev)%clone(pout%precv(lev),info) call prec%precv(lev)%clone(pout%precv(lev),info)
if (info == psb_success_) then if (info == psb_success_) then
pout%precv(lev)%base_a => pout%precv(lev)%ac pout%precv(lev)%base_a => pout%precv(lev)%ac
@@ -1001,7 +1010,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
! !
! In MLD the DESC optional argument is ignored, since ! In AMG the DESC optional argument is ignored, since
! the necessary info is contained in the various entries of the ! the necessary info is contained in the various entries of the
! PRECV component. ! PRECV component.
type(psb_desc_type), intent(in), optional :: desc type(psb_desc_type), intent(in), optional :: desc
@@ -1016,7 +1025,7 @@ contains
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999 info = psb_err_internal_error_; goto 9999
end if end if
nlev = size(prec%precv) nlev = prec%get_nlevs()
level = 1 level = 1
do level = 1, nlev do level = 1, nlev
call prec%precv(level)%allocate_wrk(info,vmold=vmold) call prec%precv(level)%allocate_wrk(info,vmold=vmold)
@@ -1039,7 +1048,6 @@ contains
subroutine amg_c_free_wrk(prec,info) subroutine amg_c_free_wrk(prec,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
! Arguments ! Arguments
class(amg_cprec_type), intent(inout) :: prec class(amg_cprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -1056,7 +1064,7 @@ contains
end if end if
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
nlev = size(prec%precv) nlev = prec%get_nlevs()
do level = 1, nlev do level = 1, nlev
call prec%precv(level)%free_wrk(info) call prec%precv(level)%free_wrk(info)
end do end do
+263 -207
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -51,7 +51,7 @@ module amg_c_slu_solver
use iso_c_binding use iso_c_binding
use amg_c_base_solver_mod use amg_c_base_solver_mod
#if defined(IPK8) #if defined(PSB_IPK8)
type, extends(amg_c_base_solver_type) :: amg_c_slu_solver_type type, extends(amg_c_base_solver_type) :: amg_c_slu_solver_type
@@ -63,9 +63,9 @@ module amg_c_slu_solver
type(c_ptr) :: lufactors=c_null_ptr type(c_ptr) :: lufactors=c_null_ptr
integer(c_long_long) :: symbsize=0, numsize=0 integer(c_long_long) :: symbsize=0, numsize=0
contains contains
procedure, pass(sv) :: build => c_slu_solver_bld procedure, pass(sv) :: build => amg_c_slu_solver_bld
procedure, pass(sv) :: apply_a => c_slu_solver_apply procedure, pass(sv) :: apply_a => amg_c_slu_solver_apply
procedure, pass(sv) :: apply_v => c_slu_solver_apply_vect procedure, pass(sv) :: apply_v => amg_c_slu_solver_apply_vect
procedure, pass(sv) :: free => c_slu_solver_free procedure, pass(sv) :: free => c_slu_solver_free
procedure, pass(sv) :: clear_data => c_slu_solver_clear_data procedure, pass(sv) :: clear_data => c_slu_solver_clear_data
procedure, pass(sv) :: descr => c_slu_solver_descr procedure, pass(sv) :: descr => c_slu_solver_descr
@@ -76,9 +76,8 @@ module amg_c_slu_solver
end type amg_c_slu_solver_type end type amg_c_slu_solver_type
private :: c_slu_solver_bld, c_slu_solver_apply, & private :: c_slu_solver_free, c_slu_solver_descr, &
& c_slu_solver_free, c_slu_solver_descr, & & c_slu_solver_sizeof, &
& c_slu_solver_sizeof, c_slu_solver_apply_vect, &
& c_slu_solver_get_fmt, c_slu_solver_get_id, & & c_slu_solver_get_fmt, c_slu_solver_get_id, &
& c_slu_solver_clear_data & c_slu_solver_clear_data
private :: c_slu_solver_finalize private :: c_slu_solver_finalize
@@ -118,207 +117,264 @@ module amg_c_slu_solver
end function amg_cslu_free end function amg_cslu_free
end interface end interface
interface
subroutine amg_c_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
use psb_base_mod
import amg_c_slu_solver_type
Implicit None
! Arguments
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_slu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_c_slu_solver_bld
end interface
interface
subroutine amg_c_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,wv,info,init,initu)
use psb_base_mod
import amg_c_slu_solver_type
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(amg_c_slu_solver_type), intent(inout) :: sv
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
type(psb_c_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu
end subroutine amg_c_slu_solver_apply_vect
end interface
interface
subroutine amg_c_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
use psb_base_mod
import amg_c_slu_solver_type
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(amg_c_slu_solver_type), intent(inout) :: sv
complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
complex(psb_spk_),intent(inout), optional :: initu(:)
end subroutine amg_c_slu_solver_apply
end interface
contains contains
subroutine c_slu_solver_apply(alpha,sv,x,beta,y,desc_data,& !!$ subroutine c_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu) !!$ & trans,work,info,init,initu)
use psb_base_mod !!$ use psb_base_mod
implicit none !!$ implicit none
type(psb_desc_type), intent(in) :: desc_data !!$ type(psb_desc_type), intent(in) :: desc_data
class(amg_c_slu_solver_type), intent(inout) :: sv !!$ class(amg_c_slu_solver_type), intent(inout) :: sv
complex(psb_spk_),intent(inout) :: x(:) !!$ complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) !!$ complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta !!$ complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans !!$ character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:) !!$ complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info !!$ integer, intent(out) :: info
character, intent(in), optional :: init !!$ character, intent(in), optional :: init
complex(psb_spk_),intent(inout), optional :: initu(:) !!$ complex(psb_spk_),intent(inout), optional :: initu(:)
!!$
integer :: n_row,n_col !!$ integer :: n_row,n_col
complex(psb_spk_), pointer :: ww(:) !!$ complex(psb_spk_), pointer :: ww(:)
type(psb_ctxt_type) :: ctxt !!$ type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act !!$ integer :: np,me,i, err_act
character :: trans_ !!$ character :: trans_
character(len=20) :: name='c_slu_solver_apply' !!$ character(len=20) :: name='c_slu_solver_apply'
!!$
call psb_erractionsave(err_act) !!$ call psb_erractionsave(err_act)
!!$
info = psb_success_ !!$ info = psb_success_
!!$
trans_ = psb_toupper(trans) !!$ trans_ = psb_toupper(trans)
select case(trans_) !!$ select case(trans_)
case('N') !!$ case('N')
case('T','C') !!$ case('T','C')
case default !!$ case default
call psb_errpush(psb_err_iarg_invalid_i_,name) !!$ call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999 !!$ goto 9999
end select !!$ end select
! !!$ !
! For non-iterative solvers, init and initu are ignored. !!$ ! For non-iterative solvers, init and initu are ignored.
! !!$ !
!!$
n_row = desc_data%get_local_rows() !!$ n_row = desc_data%get_local_rows()
n_col = desc_data%get_local_cols() !!$ n_col = desc_data%get_local_cols()
!!$
if (n_col <= size(work)) then !!$ if (n_col <= size(work)) then
ww => work(1:n_col) !!$ ww => work(1:n_col)
else !!$ else
allocate(ww(n_col),stat=info) !!$ allocate(ww(n_col),stat=info)
if (info /= psb_success_) then !!$ if (info /= psb_success_) then
info=psb_err_alloc_request_ !!$ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),& !!$ call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
& a_err='complex(psb_spk_)') !!$ & a_err='complex(psb_spk_)')
goto 9999 !!$ goto 9999
end if !!$ end if
endif !!$ endif
!!$
ww(1:n_row) = x(1:n_row) !!$ ww(1:n_row) = x(1:n_row)
select case(trans_) !!$ select case(trans_)
case('N') !!$ case('N')
info = amg_cslu_solve(0,n_row,1,ww,n_row,sv%lufactors) !!$ info = amg_cslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
case('T') !!$ case('T')
info = amg_cslu_solve(1,n_row,1,ww,n_row,sv%lufactors) !!$ info = amg_cslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
case('C') !!$ case('C')
info = amg_cslu_solve(2,n_row,1,ww,n_row,sv%lufactors) !!$ info = amg_cslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
case default !!$ case default
call psb_errpush(psb_err_internal_error_, & !!$ call psb_errpush(psb_err_internal_error_, &
& name,a_err='Invalid TRANS in ILU subsolve') !!$ & name,a_err='Invalid TRANS in ILU subsolve')
goto 9999 !!$ goto 9999
end select !!$ end select
!!$
if (info == psb_success_) & !!$ if (info == psb_success_) &
& call psb_geaxpby(alpha,ww,beta,y,desc_data,info) !!$ & call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
!!$
!!$
if (info /= psb_success_) then !!$ if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,& !!$ call psb_errpush(psb_err_internal_error_,&
& name,a_err='Error in subsolve') !!$ & name,a_err='Error in subsolve')
goto 9999 !!$ goto 9999
endif !!$ endif
!!$
if (n_col > size(work)) then !!$ if (n_col > size(work)) then
deallocate(ww) !!$ deallocate(ww)
endif !!$ endif
!!$
call psb_erractionrestore(err_act) !!$ call psb_erractionrestore(err_act)
return !!$ return
!!$
9999 call psb_error_handler(err_act) !!$9999 call psb_error_handler(err_act)
return !!$ return
!!$
end subroutine c_slu_solver_apply !!$ end subroutine c_slu_solver_apply
!!$
subroutine c_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& !!$ subroutine c_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,wv,info,init,initu) !!$ & trans,work,wv,info,init,initu)
use psb_base_mod !!$ use psb_base_mod
implicit none !!$ implicit none
type(psb_desc_type), intent(in) :: desc_data !!$ type(psb_desc_type), intent(in) :: desc_data
class(amg_c_slu_solver_type), intent(inout) :: sv !!$ class(amg_c_slu_solver_type), intent(inout) :: sv
type(psb_c_vect_type),intent(inout) :: x !!$ type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y !!$ type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta !!$ complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans !!$ character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:) !!$ complex(psb_spk_),target, intent(inout) :: work(:)
type(psb_c_vect_type),intent(inout) :: wv(:) !!$ type(psb_c_vect_type),intent(inout) :: wv(:)
integer, intent(out) :: info !!$ integer, intent(out) :: info
character, intent(in), optional :: init !!$ character, intent(in), optional :: init
type(psb_c_vect_type),intent(inout), optional :: initu !!$ type(psb_c_vect_type),intent(inout), optional :: initu
!!$
integer :: err_act !!$ integer :: err_act
character(len=20) :: name='c_slu_solver_apply_vect' !!$ character(len=20) :: name='c_slu_solver_apply_vect'
!!$
call psb_erractionsave(err_act) !!$ call psb_erractionsave(err_act)
!!$
info = psb_success_ !!$ info = psb_success_
! !!$ !
! For non-iterative solvers, init and initu are ignored. !!$ ! For non-iterative solvers, init and initu are ignored.
! !!$ !
!!$
call x%v%sync() !!$ call x%v%sync()
call y%v%sync() !!$ call y%v%sync()
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info) !!$ call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
call y%v%set_host() !!$ call y%v%set_host()
if (info /= 0) goto 9999 !!$ if (info /= 0) goto 9999
!!$
call psb_erractionrestore(err_act) !!$ call psb_erractionrestore(err_act)
return !!$ return
!!$
9999 call psb_error_handler(err_act) !!$9999 call psb_error_handler(err_act)
return !!$ return
!!$
end subroutine c_slu_solver_apply_vect !!$ end subroutine c_slu_solver_apply_vect
!!$
subroutine c_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) !!$ subroutine c_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
!!$
use psb_base_mod !!$ use psb_base_mod
!!$
Implicit None !!$ Implicit None
!!$
! Arguments !!$ ! Arguments
type(psb_cspmat_type), intent(in), target :: a !!$ type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a !!$ Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_slu_solver_type), intent(inout) :: sv !!$ class(amg_c_slu_solver_type), intent(inout) :: sv
integer, intent(out) :: info !!$ integer, intent(out) :: info
type(psb_cspmat_type), intent(in), target, optional :: b !!$ type(psb_cspmat_type), intent(in), target, optional :: b
class(psb_c_base_sparse_mat), intent(in), optional :: amold !!$ class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold !!$ class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold !!$ class(psb_i_base_vect_type), intent(in), optional :: imold
! Local variables !!$ ! Local variables
type(psb_cspmat_type) :: atmp !!$ type(psb_cspmat_type) :: atmp
type(psb_c_csc_sparse_mat) :: acsc !!$ type(psb_c_csc_sparse_mat) :: acsc
type(psb_c_coo_sparse_mat) :: acoo !!$ type(psb_c_coo_sparse_mat) :: acoo
integer :: n_row,n_col, nrow_a, nztota !!$ integer :: n_row,n_col, nrow_a, nztota
type(psb_ctxt_type) :: ctxt !!$ type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act, debug_unit, debug_level !!$ integer :: np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='c_slu_solver_bld', ch_err !!$ character(len=20) :: name='c_slu_solver_bld', ch_err
!!$
info=psb_success_ !!$ info=psb_success_
call psb_erractionsave(err_act) !!$ call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() !!$ debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() !!$ debug_level = psb_get_debug_level()
ctxt = desc_a%get_context() !!$ ctxt = desc_a%get_context()
call psb_info(ctxt, me, np) !!$ call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) & !!$ if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' start' !!$ & write(debug_unit,*) me,' ',trim(name),' start'
!!$
!!$
n_row = desc_a%get_local_rows() !!$ n_row = desc_a%get_local_rows()
n_col = desc_a%get_local_cols() !!$ n_col = desc_a%get_local_cols()
!!$
!!$
call a%cscnv(atmp,info,type='coo') !!$ call a%cscnv(atmp,info,type='coo')
call psb_rwextd(n_row,atmp,info,b=b) !!$ call psb_rwextd(n_row,atmp,info,b=b)
call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_) !!$ call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
nrow_a = atmp%get_nrows() !!$ nrow_a = atmp%get_nrows()
call atmp%a%csclip(acoo,info,jmax=nrow_a) !!$ call atmp%a%csclip(acoo,info,jmax=nrow_a)
call acsc%mv_from_coo(acoo,info) !!$ call acsc%mv_from_coo(acoo,info)
nztota = acsc%get_nzeros() !!$ nztota = acsc%get_nzeros()
! Fix the entries to call C-base SuperLU !!$ ! Fix the entries to call C-base SuperLU
acsc%ia(:) = acsc%ia(:) - 1 !!$ acsc%ia(:) = acsc%ia(:) - 1
acsc%icp(:) = acsc%icp(:) - 1 !!$ acsc%icp(:) = acsc%icp(:) - 1
info = amg_cslu_fact(nrow_a,nztota,acsc%val,& !!$ info = amg_cslu_fact(nrow_a,nztota,acsc%val,&
& acsc%icp,acsc%ia,sv%lufactors) !!$ & acsc%icp,acsc%ia,sv%lufactors)
!!$
if (info /= psb_success_) then !!$ if (info /= psb_success_) then
info=psb_err_from_subroutine_ !!$ info=psb_err_from_subroutine_
ch_err='amg_cslu_fact' !!$ ch_err='amg_cslu_fact'
call psb_errpush(info,name,a_err=ch_err) !!$ call psb_errpush(info,name,a_err=ch_err)
goto 9999 !!$ goto 9999
end if !!$ end if
!!$
call acsc%free() !!$ call acsc%free()
call atmp%free() !!$ call atmp%free()
!!$
if (debug_level >= psb_debug_outer_) & !!$ if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' end' !!$ & write(debug_unit,*) me,' ',trim(name),' end'
!!$
call psb_erractionrestore(err_act) !!$ call psb_erractionrestore(err_act)
return !!$ return
!!$
9999 call psb_error_handler(err_act) !!$9999 call psb_error_handler(err_act)
return !!$ return
end subroutine c_slu_solver_bld !!$ end subroutine c_slu_solver_bld
subroutine c_slu_solver_free(sv,info) subroutine c_slu_solver_free(sv,info)
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -97,7 +97,7 @@ contains
character(len=*), intent(in), optional :: prefix character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_ character(1024) :: prefix_
info = psb_success_
if (present(prefix)) then if (present(prefix)) then
prefix_ = prefix prefix_ = prefix
else else
+23
View File
@@ -0,0 +1,23 @@
#ifndef AMG_CONFIG_H
#define AMG_CONFIG_H
#include "psb_config.h"
#define AMG_VERSION_MAJOR @AMGMAJOR@
#define AMG_VERSION_MINOR @AMGMINOR@
#define AMG_VERSION_PATCHLEVEL @AMGPATCH@
#define AMG_VERSION_STRING @AMGSTRING@
@CHAVEUMF@
@CHAVESLU@
@CSLUVERSION@
@CHAVESLUDIST@
@CSLUDISTVERSION@
@CHAVEMUMPS@
@CHAVEMUMPSMODULES@
@CHAVEMUMPSINCLUDES@
@CXXMATCHBOXBIT@
#endif
-107
View File
@@ -1,107 +0,0 @@
/* This file was generated by a script using the mld_base_prec_type.F90 file as a basis. */
#ifndef MLD_CONST_H_
#define MLD_CONST_H_
#ifdef __cplusplus
extern "C" {
#endif
#define MLD_VERSION_STRING_ ( "2.0.0" )
#define MLD_VERSION_MAJOR_ ( 2 )
#define MLD_VERSION_MINOR_ ( 0 )
#define MLD_PATCHLEVEL_ ( 0 )
#define MLD_SMOOTHER_TYPE_ ( 1 )
#define MLD_SUB_SOLVE_ ( 2 )
#define MLD_SUB_RESTR_ ( 3 )
#define MLD_SUB_PROL_ ( 4 )
#define MLD_SUB_REN_ ( 5 )
#define MLD_SUB_OVR_ ( 6 )
#define MLD_SUB_FILLIN_ ( 8 )
#define MLD_SLU_PTR_ ( 10 )
#define MLD_UMF_SYMPTR_ ( 12 )
#define MLD_UMF_NUMPTR_ ( 14 )
#define MLD_SLUD_PTR_ ( 16 )
#define MLD_PREC_STATUS_ ( 18 )
#define MLD_ML_TYPE_ ( 20 )
#define MLD_SMOOTHER_SWEEPS_PRE_ ( 21 )
#define MLD_SMOOTHER_SWEEPS_POST_ ( 22 )
#define MLD_SMOOTHER_POS_ ( 23 )
#define MLD_AGGR_KIND_ ( 24 )
#define MLD_AGGR_ALG_ ( 25 )
#define MLD_AGGR_OMEGA_ALG_ ( 26 )
#define MLD_AGGR_EIG_ ( 27 )
#define MLD_AGGR_FILTER_ ( 28 )
#define MLD_COARSE_MAT_ ( 29 )
#define MLD_COARSE_SOLVE_ ( 30 )
#define MLD_COARSE_SWEEPS_ ( 31 )
#define MLD_COARSE_FILLIN_ ( 32 )
#define MLD_COARSE_SUBSOLVE_ ( 33 )
#define MLD_SMOOTHER_SWEEPS_ ( 34 )
#define MLD_IFPSZ_ ( 36 )
#define MLD_MIN_PREC_ ( 0 )
#define MLD_NOPREC_ ( 0 )
#define MLD_JAC_ ( 1 )
#define MLD_BJAC_ ( 2 )
#define MLD_AS_ ( 3 )
#define MLD_MAX_PREC_ ( 3 )
#define MLD_SLV_DELTA_ ( MLD_MAX_PREC_+1 )
#define MLD_F_NONE_ ( MLD_SLV_DELTA_+0 )
#define MLD_DIAG_SCALE_ ( MLD_SLV_DELTA_+1 )
#define MLD_ILU_N_ ( MLD_SLV_DELTA_+2 )
#define MLD_MILU_N_ ( MLD_SLV_DELTA_+3 )
#define MLD_ILU_T_ ( MLD_SLV_DELTA_+4 )
#define MLD_SLU_ ( MLD_SLV_DELTA_+5 )
#define MLD_UMF_ ( MLD_SLV_DELTA_+6 )
#define MLD_SLUDIST_ ( MLD_SLV_DELTA_+7 )
#define MLD_MAX_SUB_SOLVE_ ( MLD_SLV_DELTA_+7 )
#define MLD_MIN_SUB_SOLVE_ ( MLD_DIAG_SCALE_ )
#define MLD_RENUM_NONE_ (0 )
#define MLD_RENUM_GLB_ (1 )
#define MLD_RENUM_GPS_ (2 )
#define MLD_MAX_RENUM_ (1 )
#define MLD_NO_ML_ ( 0 )
#define MLD_ADD_ML_ ( 1 )
#define MLD_MULT_ML_ ( 2 )
#define MLD_NEW_ML_PREC_ ( 3 )
#define MLD_MAX_ML_TYPE_ ( MLD_MULT_ML_ )
#define MLD_PRE_SMOOTH_ (1 )
#define MLD_POST_SMOOTH_ (2 )
#define MLD_TWOSIDE_SMOOTH_ (3 )
#define MLD_MAX_SMOOTH_ (MLD_TWOSIDE_SMOOTH_ )
#define MLD_NO_SMOOTH_ ( 0 )
#define MLD_SMOOTH_PROL_ ( 1 )
#define MLD_MIN_ENERGY_ ( 2 )
#define MLD_BIZ_PROL_ ( 3 )
#define MLD_MAX_AGGR_KIND_ (MLD_MIN_ENERGY_ )
#define MLD_NO_FILTER_MAT_ (0 )
#define MLD_FILTER_MAT_ (1 )
#define MLD_MAX_FILTER_MAT_ (MLD_NO_FILTER_MAT_ )
#define MLD_DEC_AGGR_ (0 )
#define MLD_SYM_DEC_AGGR_ (1 )
#define MLD_GLB_AGGR_ (2 )
#define MLD_NEW_DEC_AGGR_ (3 )
#define MLD_NEW_GLB_AGGR_ (4 )
#define MLD_MAX_AGGR_ALG_ (MLD_DEC_AGGR_ )
#define MLD_EIG_EST_ (0 )
#define MLD_USER_CHOICE_ (999 )
#define MLD_MAX_NORM_ (0 )
#define MLD_DISTR_MAT_ (0 )
#define MLD_REPL_MAT_ (1 )
#define MLD_MAX_COARSE_MAT_ (MLD_REPL_MAT_ )
#define MLD_PREC_BUILT_ (98765 )
#define MLD_SUB_ILUTHRS_ ( 1 )
#define MLD_AGGR_OMEGA_VAL_ ( 2 )
#define MLD_AGGR_THRESH_ ( 3 )
#define MLD_COARSE_ILUTHRS_ ( 4 )
#define MLD_RFPSZ_ ( 8 )
#define MLD_L_PR_ (1 )
#define MLD_U_PR_ (2 )
#define MLD_BP_ILU_AVSZ_ (2 )
#define MLD_AP_ND_ (3 )
#define MLD_AC_ (4 )
#define MLD_SM_PR_T_ (5 )
#define MLD_SM_PR_ (6 )
#define MLD_SMTH_AVSZ_ (6 )
#define MLD_MAX_AVSZ_ (MLD_SMTH_AVSZ_ )
#ifdef __cplusplus
}
#endif
#endif
+3 -6
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -62,9 +62,6 @@ module amg_d_ainv_solver
procedure, pass(sv) :: cseti => amg_d_ainv_solver_cseti procedure, pass(sv) :: cseti => amg_d_ainv_solver_cseti
procedure, pass(sv) :: csetc => amg_d_ainv_solver_csetc procedure, pass(sv) :: csetc => amg_d_ainv_solver_csetc
procedure, pass(sv) :: csetr => amg_d_ainv_solver_csetr procedure, pass(sv) :: csetr => amg_d_ainv_solver_csetr
!!$ procedure, pass(sv) :: seti => amg_d_ainv_solver_seti
!!$ procedure, pass(sv) :: setc => amg_d_ainv_solver_setc
!!$ procedure, pass(sv) :: setr => amg_d_ainv_solver_setr
procedure, pass(sv) :: descr => amg_d_ainv_solver_descr procedure, pass(sv) :: descr => amg_d_ainv_solver_descr
procedure, pass(sv) :: default => d_ainv_solver_default procedure, pass(sv) :: default => d_ainv_solver_default
procedure, nopass :: stringval => d_ainv_stringval procedure, nopass :: stringval => d_ainv_stringval
@@ -106,7 +103,7 @@ module amg_d_ainv_solver
Implicit None Implicit None
! Arguments ! Arguments
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_ainv_solver_type), intent(inout) :: sv class(amg_d_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -228,7 +225,7 @@ module amg_d_ainv_solver
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, psb_ipk_ & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, psb_ipk_
implicit none implicit none
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
integer(psb_ipk_), intent(in) :: fillin,alg integer(psb_ipk_), intent(in) :: fillin,alg
real(psb_dpk_), intent(in) :: thresh real(psb_dpk_), intent(in) :: thresh
type(psb_dspmat_type), intent(inout) :: wmat, zmat type(psb_dspmat_type), intent(inout) :: wmat, zmat
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -230,7 +230,7 @@ module amg_d_as_smoother
& psb_desc_type, psb_d_base_sparse_mat, psb_ipk_,& & psb_desc_type, psb_d_base_sparse_mat, psb_ipk_,&
& psb_i_base_vect_type & psb_i_base_vect_type
implicit none implicit none
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_as_smoother_type), intent(inout) :: sm class(amg_d_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+8 -8
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -89,7 +89,7 @@ module amg_d_base_aggregator_mod
procedure, pass(ag) :: bld_tprol => amg_d_base_aggregator_build_tprol procedure, pass(ag) :: bld_tprol => amg_d_base_aggregator_build_tprol
procedure, pass(ag) :: mat_bld => amg_d_base_aggregator_mat_bld procedure, pass(ag) :: mat_bld => amg_d_base_aggregator_mat_bld
procedure, pass(ag) :: mat_asb => amg_d_base_aggregator_mat_asb procedure, pass(ag) :: mat_asb => amg_d_base_aggregator_mat_asb
procedure, pass(ag) :: bld_map => amg_d_base_aggregator_bld_map procedure, pass(ag) :: bld_linmap => amg_d_base_aggregator_bld_linmap
procedure, pass(ag) :: update_next => amg_d_base_aggregator_update_next procedure, pass(ag) :: update_next => amg_d_base_aggregator_update_next
procedure, pass(ag) :: clone => amg_d_base_aggregator_clone procedure, pass(ag) :: clone => amg_d_base_aggregator_clone
procedure, pass(ag) :: free => amg_d_base_aggregator_free procedure, pass(ag) :: free => amg_d_base_aggregator_free
@@ -302,7 +302,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Do nothing ! Do nothing
info = psb_success_
return return
end subroutine amg_d_base_aggregator_set_aggr_type end subroutine amg_d_base_aggregator_set_aggr_type
@@ -458,7 +458,7 @@ contains
end subroutine amg_d_base_aggregator_mat_asb end subroutine amg_d_base_aggregator_mat_asb
! !
!> Function bld_map !> Function bld_linmap
!! \memberof amg_d_base_aggregator_type !! \memberof amg_d_base_aggregator_type
!! \brief Build linear map between hierarchy levels !! \brief Build linear map between hierarchy levels
!! !!
@@ -473,7 +473,7 @@ contains
!! \param map The output map !! \param map The output map
!! \param info Return code !! \param info Return code
!! !!
subroutine amg_d_base_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,& subroutine amg_d_base_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
& op_restr,op_prol,map,info) & op_restr,op_prol,map,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
@@ -484,8 +484,9 @@ contains
type(psb_dlinmap_type), intent(out) :: map type(psb_dlinmap_type), intent(out) :: map
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_aggregator_bld_map' character(len=20) :: name='d_base_aggregator_bld_linmap'
info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! !
! Copy the prolongation/restriction matrices into the descriptor map. ! Copy the prolongation/restriction matrices into the descriptor map.
@@ -507,7 +508,6 @@ contains
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine amg_d_base_aggregator_bld_map end subroutine amg_d_base_aggregator_bld_linmap
end module amg_d_base_aggregator_mod end module amg_d_base_aggregator_mod
+1 -1
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -237,7 +237,7 @@ module amg_d_base_smoother_mod
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_base_smoother_type, psb_ipk_, psb_i_base_vect_type & amg_d_base_smoother_type, psb_ipk_, psb_i_base_vect_type
! Arguments ! Arguments
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_base_smoother_type), intent(inout) :: sm class(amg_d_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -170,7 +170,7 @@ module amg_d_base_solver_mod
Implicit None Implicit None
! Arguments ! Arguments
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_base_solver_type), intent(inout) :: sv class(amg_d_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+3 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -150,7 +150,7 @@ contains
class(amg_d_dec_aggregator_type), intent(inout) :: ag class(amg_d_dec_aggregator_type), intent(inout) :: ag
type(amg_dml_parms), intent(in) :: parms type(amg_dml_parms), intent(in) :: parms
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_
select case(parms%aggr_type) select case(parms%aggr_type)
case (amg_noalg_) case (amg_noalg_)
ag%soc_map_bld => null() ag%soc_map_bld => null()
@@ -192,6 +192,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_ character(1024) :: prefix_
info = psb_success_
if (present(prefix)) then if (present(prefix)) then
prefix_ = prefix prefix_ = prefix
else else
+3 -3
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -119,7 +119,7 @@ module amg_d_diag_solver
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_diag_solver_type, psb_ipk_, psb_i_base_vect_type & amg_d_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_diag_solver_type), intent(inout) :: sv class(amg_d_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -331,7 +331,7 @@ module amg_d_l1_diag_solver
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type & amg_d_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_l1_diag_solver_type), intent(inout) :: sv class(amg_d_l1_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -181,7 +181,7 @@ module amg_d_gs_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,& & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_gs_solver_type), intent(inout) :: sv class(amg_d_gs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -195,7 +195,7 @@ module amg_d_gs_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,& & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_bwgs_solver_type), intent(inout) :: sv class(amg_d_bwgs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
-125
View File
@@ -1,125 +0,0 @@
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. 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.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific 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 THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
! 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.
!
!
!
!
! The aggregator object hosts the aggregation method for building
! the multilevel hierarchy. This variant is based on the hybrid method
! presented in
!
! S. Gratton, P. Henon, P. Jiranek and X. Vasseur:
! Reducing complexity of algebraic multigrid by aggregation
! Numerical Lin. Algebra with Applications, 2016, 23:501-518
!
module amg_d_hybrid_aggregator_mod
use amg_d_dec_aggregator_mod
!
! sm - class(amg_T_base_smoother_type), allocatable
! The current level preconditioner (aka smoother).
! parms - type(amg_RTml_parms)
! The parameters defining the multilevel strategy.
! ac - The local part of the current-level matrix, built by
! coarsening the previous-level matrix.
! desc_ac - type(psb_desc_type).
! The communication descriptor associated to the matrix
! stored in ac.
! base_a - type(psb_Tspmat_type), pointer.
! Pointer (really a pointer!) to the local part of the current
! matrix (so we have a unified treatment of residuals).
! We need this to avoid passing explicitly the current matrix
! to the routine which applies the preconditioner.
! base_desc - type(psb_desc_type), pointer.
! Pointer to the communication descriptor associated to the
! matrix pointed by base_a.
! map - Stores the maps (restriction and prolongation) between the
! vector spaces associated to the index spaces of the previous
! and current levels.
!
! Methods:
! Most methods follow the encapsulation hierarchy: they take whatever action
! is appropriate for the current object, then call the corresponding method for
! the contained object.
! As an example: the descr() method prints out a description of the
! level. It starts by invoking the descr() method of the parms object,
! then calls the descr() method of the smoother object.
!
! descr - Prints a description of the object.
! default - Set default values
! dump - Dump to file object contents
! set - Sets various parameters; when a request is unknown
! it is passed to the smoother object for further processing.
! check - Sanity checks.
! sizeof - Total memory occupation in bytes
! get_nzeros - Number of nonzeros
!
!
type, extends(amg_d_dec_aggregator_type) :: amg_d_hybrid_aggregator_type
contains
procedure, pass(ag) :: bld_tprol => amg_d_hybrid_aggregator_build_tprol
procedure, nopass :: fmt => amg_d_hybrid_aggregator_fmt
end type amg_d_hybrid_aggregator_type
interface
subroutine amg_d_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
import :: amg_d_hybrid_aggregator_type, psb_desc_type, psb_dspmat_type, psb_dpk_, &
& psb_ipk_, psb_long_int_k_, amg_dml_parms
implicit none
class(amg_d_hybrid_aggregator_type), target, intent(inout) :: ag
type(amg_dml_parms), intent(inout) :: parms
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
type(psb_dspmat_type), intent(out) :: op_prol
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_hybrid_aggregator_build_tprol
end interface
contains
function amg_d_hybrid_aggregator_fmt() result(val)
implicit none
character(len=32) :: val
val = "Hybrid Decoupled aggregation"
end function amg_d_hybrid_aggregator_fmt
end module amg_d_hybrid_aggregator_mod
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -123,7 +123,7 @@ contains
Implicit None Implicit None
! Arguments ! Arguments
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_id_solver_type), intent(inout) :: sv class(amg_d_id_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+1 -1
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -144,7 +144,7 @@ module amg_d_ilu_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,& & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_ilu_solver_type), intent(inout) :: sv class(amg_d_ilu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+4 -4
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -56,7 +56,7 @@ module amg_d_inner_mod
& psb_dpk_, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_ & psb_dpk_, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
import :: amg_dprec_type import :: amg_dprec_type
implicit none implicit none
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
type(amg_dprec_type), intent(inout), target :: prec type(amg_dprec_type), intent(inout), target :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -67,7 +67,7 @@ module amg_d_inner_mod
end interface amg_mlprec_bld end interface amg_mlprec_bld
interface amg_mlprec_aply interface amg_mlprec_aply
subroutine amg_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) subroutine amg_dmlprec_aply_a(alpha,p,x,beta,y,desc_data,trans,work,info)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_ import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
import :: amg_dprec_type import :: amg_dprec_type
implicit none implicit none
@@ -79,7 +79,7 @@ module amg_d_inner_mod
character,intent(in) :: trans character,intent(in) :: trans
real(psb_dpk_),target :: work(:) real(psb_dpk_),target :: work(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine amg_dmlprec_aply end subroutine amg_dmlprec_aply_a
subroutine amg_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) subroutine amg_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
import :: psb_dspmat_type, psb_desc_type, & import :: psb_dspmat_type, psb_desc_type, &
& psb_dpk_, psb_d_vect_type, psb_ipk_ & psb_dpk_, psb_d_vect_type, psb_ipk_
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -94,7 +94,7 @@ module amg_d_invk_solver
Implicit None Implicit None
! Arguments ! Arguments
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_invk_solver_type), intent(inout) :: sv class(amg_d_invk_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -94,7 +94,7 @@ module amg_d_invt_solver
Implicit None Implicit None
! Arguments ! Arguments
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_invt_solver_type), intent(inout) :: sv class(amg_d_invt_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -151,7 +151,7 @@ module amg_d_jac_smoother
import :: psb_desc_type, amg_d_jac_smoother_type, psb_d_vect_type, psb_dpk_, & import :: psb_desc_type, amg_d_jac_smoother_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,& & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_jac_smoother_type), intent(inout) :: sm class(amg_d_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -274,7 +274,7 @@ module amg_d_jac_smoother
import :: psb_desc_type, amg_d_l1_jac_smoother_type, psb_d_vect_type, & import :: psb_desc_type, amg_d_l1_jac_smoother_type, psb_d_vect_type, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,& & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_l1_jac_smoother_type), intent(inout) :: sm class(amg_d_l1_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -143,7 +143,7 @@ module amg_d_jac_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,& & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_jac_solver_type), intent(inout) :: sv class(amg_d_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -160,7 +160,7 @@ module amg_d_jac_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,& & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_l1_jac_solver_type), intent(inout) :: sv class(amg_d_l1_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -23,7 +23,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -57,7 +57,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -174,7 +174,7 @@ module amg_d_krm_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,& & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_krm_solver_type), intent(inout) :: sv class(amg_d_krm_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -54,7 +54,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -73,6 +73,22 @@ module amg_d_matchboxp_mod
use iso_c_binding use iso_c_binding
use psb_base_cbind_mod use psb_base_cbind_mod
#if defined(PSB_SERIAL_MPI)
interface MatchingC
subroutine dMatchingC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate) bind(c,name='dMatching')
use iso_c_binding
import :: psb_c_ipk_, psb_c_lpk_
implicit none
integer(psb_c_lpk_), value :: nlver,nledge
integer(psb_c_lpk_) :: verlocptr(*),verlocind(*), verdistance(*)
integer(psb_c_lpk_) :: mate(*)
real(c_double) :: edgelocweight(*)
end subroutine dMatchingC
end interface MatchingC
#else
interface MatchBoxPC interface MatchBoxPC
subroutine dMatchBoxPC(nlver,nledge,verlocptr,verlocind,edgelocweight,& subroutine dMatchBoxPC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate, myrank, numprocs, icomm,& & verdistance, mate, myrank, numprocs, icomm,&
@@ -93,7 +109,7 @@ module amg_d_matchboxp_mod
real(c_double) :: msgpercent(*) real(c_double) :: msgpercent(*)
end subroutine dMatchBoxPC end subroutine dMatchBoxPC
end interface MatchBoxPC end interface MatchBoxPC
#endif
interface amg_i_aggr_assign interface amg_i_aggr_assign
module procedure amg_i_d_aggr_assign module procedure amg_i_d_aggr_assign
end interface amg_i_aggr_assign end interface amg_i_aggr_assign
@@ -145,7 +161,7 @@ contains
logical, parameter :: dump=.false., debug=.false., dump_mate=.false., & logical, parameter :: dump=.false., debug=.false., dump_mate=.false., &
& debug_ilaggr=.false., debug_sync=.false., debug_mate=.false. & debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1 integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
logical, parameter :: do_timings=.true. logical, parameter :: do_timings=.false.
integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2 integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
ictxt = desc_a%get_ctxt() ictxt = desc_a%get_ctxt()
@@ -608,7 +624,7 @@ contains
logical, parameter :: old_style=.false., sort_minp=.true. logical, parameter :: old_style=.false., sort_minp=.true.
character(len=40) :: name='build_matching', fname character(len=40) :: name='build_matching', fname
integer(psb_ipk_), save :: idx_cmboxp=-1, idx_bldahat=-1, idx_phase2=-1, idx_phase3=-1 integer(psb_ipk_), save :: idx_cmboxp=-1, idx_bldahat=-1, idx_phase2=-1, idx_phase3=-1
logical, parameter :: do_timings=.true. logical, parameter :: do_timings=.false.
ictxt = desc_a%get_ctxt() ictxt = desc_a%get_ctxt()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@@ -810,7 +826,7 @@ contains
character(len=80) :: aname character(len=80) :: aname
real(psb_dpk_), parameter :: eps=epsilon(1.d0) real(psb_dpk_), parameter :: eps=epsilon(1.d0)
integer(psb_ipk_), save :: idx_glbt=-1, idx_phase1=-1, idx_phase2=-1 integer(psb_ipk_), save :: idx_glbt=-1, idx_phase1=-1, idx_phase2=-1
logical, parameter :: do_timings=.true. logical, parameter :: do_timings=.false.
logical, parameter :: debug_symmetry = .false., check_size=.false. logical, parameter :: debug_symmetry = .false., check_size=.false.
logical, parameter :: unroll_logtrans=.false. logical, parameter :: unroll_logtrans=.false.
@@ -863,7 +879,7 @@ contains
nr = tcoo1%get_nrows() nr = tcoo1%get_nrows()
nc = tcoo1%get_ncols() nc = tcoo1%get_ncols()
nz = tcoo1%get_nzeros() nz = tcoo1%get_nzeros()
call tcoo2%allocate(nr,nc,int(1.25*nz)) call tcoo2%allocate(nr,nc,int(1.25*nz,psb_ipk_))
k2 = 0 k2 = 0
! !
! Build the entries of \^A for matching ! Build the entries of \^A for matching
@@ -1040,7 +1056,8 @@ contains
integer(psb_c_lpk_) :: ph1_card(*),ph2_card(*) integer(psb_c_lpk_) :: ph1_card(*),ph2_card(*)
real(c_double) :: edgelocweight(:) real(c_double) :: edgelocweight(:)
real(c_double) :: msgpercent(*) real(c_double) :: msgpercent(*)
integer(psb_ipk_) :: info, me, np integer(psb_ipk_) :: info
integer(psb_mpk_) :: me, np
integer(psb_c_mpk_) :: icomm, mrank, mnp integer(psb_c_mpk_) :: icomm, mrank, mnp
logical, optional :: display_inp logical, optional :: display_inp
! !
@@ -1129,11 +1146,15 @@ contains
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (me == 0) write(0,*)' Calling MatchBoxP ' if (me == 0) write(0,*)' Calling MatchBoxP '
end if end if
#if defined(PSB_SERIAL_MPI)
call MatchingC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate)
#else
call MatchBoxPC(nlver,nledge,verlocptr,verlocind,edgelocweight,& call MatchBoxPC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate, mrank, mnp, icomm,& & verdistance, mate, mrank, mnp, icomm,&
& msgindsent,msgactualsent,msgpercent,& & msgindsent,msgactualsent,msgpercent,&
& ph0_time, ph1_time, ph2_time, ph1_card, ph2_card) & ph0_time, ph1_time, ph2_time, ph1_card, ph2_card)
#endif
verlocptr(:) = verlocptr(:) + 1 verlocptr(:) = verlocptr(:) + 1
verlocind(:) = verlocind(:) + 1 verlocind(:) = verlocind(:) + 1
verdistance(:) = verdistance(:) + 1 verdistance(:) = verdistance(:) + 1
+13 -13
View File
@@ -21,7 +21,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -52,10 +52,10 @@
! !
module amg_d_mumps_solver module amg_d_mumps_solver
use amg_d_base_solver_mod use amg_d_base_solver_mod
#if defined(HAVE_MUMPS_) && defined(HAVE_MUMPS_MODULES_) #if defined(AMG_HAVE_MUMPS) && defined(AMG_HAVE_MUMPS_MODULES)
use dmumps_struc_def use dmumps_struc_def
#endif #endif
#if defined(HAVE_MUMPS_) && defined(HAVE_MUMPS_INCLUDES_) #if defined(AMG_HAVE_MUMPS) && defined(AMG_HAVE_MUMPS_INCLUDES)
include 'dmumps_struc.h' include 'dmumps_struc.h'
#endif #endif
@@ -68,7 +68,7 @@ module amg_d_mumps_solver
end type amg_d_mumps_rcntl_item end type amg_d_mumps_rcntl_item
type, extends(amg_d_base_solver_type) :: amg_d_mumps_solver_type type, extends(amg_d_base_solver_type) :: amg_d_mumps_solver_type
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
type(dmumps_struc), allocatable :: id type(dmumps_struc), allocatable :: id
#else #else
integer, allocatable :: id integer, allocatable :: id
@@ -163,7 +163,7 @@ module amg_d_mumps_solver
Implicit None Implicit None
! Arguments ! Arguments
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_mumps_solver_type), intent(inout) :: sv class(amg_d_mumps_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -189,7 +189,7 @@ contains
info = 0 info = 0
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@@ -239,7 +239,7 @@ contains
character(len=20) :: name='d_mumps_solver_clear_data' character(len=20) :: name='d_mumps_solver_clear_data'
info = 0 info = 0
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (allocated(sv%id)) then if (allocated(sv%id)) then
if (sv%built) then if (sv%built) then
@@ -279,7 +279,7 @@ contains
character(len=20) :: name='d_mumps_solver_free' character(len=20) :: name='d_mumps_solver_free'
info = 0 info = 0
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call sv%clear_data(info) call sv%clear_data(info)
if ((info == 0).and.allocated(sv%icntl)) deallocate(sv%icntl,stat=info) if ((info == 0).and.allocated(sv%icntl)) deallocate(sv%icntl,stat=info)
@@ -383,7 +383,7 @@ subroutine d_mumps_solver_csetc(sv,what,val,info,idx)
select case(psb_toupper(trim(what))) select case(psb_toupper(trim(what)))
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
case('MUMPS_LOC_GLOB') case('MUMPS_LOC_GLOB')
sv%ipar(1) = sv%stringval(psb_toupper(trim(val))) sv%ipar(1) = sv%stringval(psb_toupper(trim(val)))
#endif #endif
@@ -421,7 +421,7 @@ subroutine d_mumps_solver_cseti(sv,what,val,info,idx)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
select case(psb_toupper(what)) select case(psb_toupper(what))
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
case('MUMPS_LOC_GLOB') case('MUMPS_LOC_GLOB')
sv%ipar(1) = val sv%ipar(1) = val
case('MUMPS_PRINT_ERR') case('MUMPS_PRINT_ERR')
@@ -467,7 +467,7 @@ subroutine d_mumps_solver_csetr(sv,what,val,info,idx)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
select case(psb_toupper(what)) select case(psb_toupper(what))
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
case('MUMPS_RPAR_ENTRY') case('MUMPS_RPAR_ENTRY')
if(present(idx)) then if(present(idx)) then
! Note: this will allocate %item ! Note: this will allocate %item
@@ -504,7 +504,7 @@ subroutine d_mumps_solver_default(sv)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
if (.not.allocated(sv%id)) then if (.not.allocated(sv%id)) then
allocate(sv%id,stat=info) allocate(sv%id,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
@@ -561,7 +561,7 @@ function d_mumps_solver_sizeof(sv) result(val)
class(amg_d_mumps_solver_type), intent(in) :: sv class(amg_d_mumps_solver_type), intent(in) :: sv
integer(psb_epk_) :: val integer(psb_epk_) :: val
integer :: i integer :: i
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
val = (sv%id%INFOG(22)+sv%id%INFOG(32))*1d+6 val = (sv%id%INFOG(22)+sv%id%INFOG(32))*1d+6
#else #else
val = 0 val = 0
+161 -376
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -155,13 +155,35 @@ module amg_d_onelev_mod
private :: d_wrk_alloc, d_wrk_free, & private :: d_wrk_alloc, d_wrk_free, &
& d_wrk_clone, d_wrk_move_alloc, d_wrk_cnv, d_wrk_sizeof & d_wrk_clone, d_wrk_move_alloc, d_wrk_cnv, d_wrk_sizeof
!
! Remap.
! This keeps track of remapping.
! Logic here is as follows:
! 1. AC_PRE_REMAP need to figure out if we
! really need it.
! 2. DESC_AC_PRE_REMAP contains the descriptor before
! remapping. Meaning that it is possible
! to implement the RESTRICTOR operator by
! a. Doing LINMAP_U2V onto this one
! b. For each process, send the data to
! IDEST.
! This assumes that remapping goes by
! a factor of 2.
! For the PROLONGATOR operators, we first
! use DESC_AC, then split and send onto
! the processes in DESC_AC_PRE_REMAP.
!
! To be fixed: what happens if NP the starting processes
! is not an even number? Coordinate with _X_remap in PSBLAS
!
type amg_d_remap_data_type type amg_d_remap_data_type
type(psb_dspmat_type) :: ac_pre_remap type(psb_dspmat_type) :: ac_pre_remap
type(psb_desc_type) :: desc_ac_pre_remap type(psb_desc_type) :: desc_ac_pre_remap
integer(psb_ipk_) :: idest integer(psb_ipk_) :: idest
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:) integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
contains contains
procedure, pass(rmp) :: clone => d_remap_data_clone procedure, pass(rmp) :: clone => d_remap_data_clone
procedure, pass(rmp) :: move_alloc => d_remap_move_alloc
end type amg_d_remap_data_type end type amg_d_remap_data_type
type amg_d_onelev_type type amg_d_onelev_type
@@ -207,7 +229,7 @@ module amg_d_onelev_mod
procedure, pass(lv) :: get_wrksz => d_base_onelev_get_wrksize procedure, pass(lv) :: get_wrksz => d_base_onelev_get_wrksize
procedure, pass(lv) :: allocate_wrk => d_base_onelev_allocate_wrk procedure, pass(lv) :: allocate_wrk => d_base_onelev_allocate_wrk
procedure, pass(lv) :: free_wrk => d_base_onelev_free_wrk procedure, pass(lv) :: free_wrk => d_base_onelev_free_wrk
procedure, nopass :: stringval => amg_stringval procedure, nopass :: stringval => amg_stringval
procedure, pass(lv) :: move_alloc => d_base_onelev_move_alloc procedure, pass(lv) :: move_alloc => d_base_onelev_move_alloc
@@ -231,9 +253,7 @@ module amg_d_onelev_mod
& d_base_onelev_free_wrk & d_base_onelev_free_wrk
interface interface
subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) module subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_, psb_ldspmat_type, psb_lpk_
import :: amg_d_onelev_type
implicit none implicit none
class(amg_d_onelev_type), intent(inout), target :: lv class(amg_d_onelev_type), intent(inout), target :: lv
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
@@ -245,10 +265,7 @@ module amg_d_onelev_mod
end interface end interface
interface interface
subroutine amg_d_base_onelev_build(lv,info,amold,vmold,imold,ilv) module subroutine amg_d_base_onelev_build(lv,info,amold,vmold,imold,ilv)
import :: psb_d_base_sparse_mat, psb_d_base_vect_type, &
& psb_i_base_vect_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv class(amg_d_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -260,10 +277,7 @@ module amg_d_onelev_mod
end interface end interface
interface interface
subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix) module subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments ! Arguments
class(amg_d_onelev_type), intent(in) :: lv class(amg_d_onelev_type), intent(in) :: lv
@@ -276,10 +290,8 @@ module amg_d_onelev_mod
end interface end interface
interface interface
subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global) module subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,&
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & & iout,verbosity, prefix,global)
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments ! Arguments
class(amg_d_onelev_type), intent(in) :: lv class(amg_d_onelev_type), intent(in) :: lv
@@ -293,10 +305,7 @@ module amg_d_onelev_mod
end interface end interface
interface interface
subroutine amg_d_base_onelev_cnv(lv,info,amold,vmold,imold) module subroutine amg_d_base_onelev_cnv(lv,info,amold,vmold,imold)
import :: amg_d_onelev_type, psb_d_base_vect_type, psb_dpk_, &
& psb_d_base_sparse_mat, psb_ipk_, psb_i_base_vect_type
! Arguments
class(amg_d_onelev_type), intent(inout) :: lv class(amg_d_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_sparse_mat), intent(in), optional :: amold
@@ -306,48 +315,32 @@ module amg_d_onelev_mod
end interface end interface
interface interface
subroutine amg_d_base_onelev_free(lv,info) module subroutine amg_d_base_onelev_free(lv,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none implicit none
class(amg_d_onelev_type), intent(inout) :: lv class(amg_d_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_base_onelev_free end subroutine amg_d_base_onelev_free
end interface end interface
interface interface
subroutine amg_d_base_onelev_free_smoothers(lv,info) module subroutine amg_d_base_onelev_free_smoothers(lv,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none implicit none
class(amg_d_onelev_type), intent(inout) :: lv class(amg_d_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_base_onelev_free_smoothers end subroutine amg_d_base_onelev_free_smoothers
end interface end interface
interface interface
subroutine amg_d_base_onelev_check(lv,info) module subroutine amg_d_base_onelev_check(lv,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_d_onelev_type), intent(inout) :: lv class(amg_d_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_base_onelev_check end subroutine amg_d_base_onelev_check
end interface end interface
interface interface
subroutine amg_d_base_onelev_setsm(lv,val,info,pos) module subroutine amg_d_base_onelev_setsm(lv,val,info,pos)
import :: psb_dpk_, amg_d_onelev_type, amg_d_base_smoother_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_d_onelev_type), target, intent(inout) :: lv class(amg_d_onelev_type), target, intent(inout) :: lv
class(amg_d_base_smoother_type), intent(in) :: val class(amg_d_base_smoother_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -356,12 +349,8 @@ module amg_d_onelev_mod
end interface end interface
interface interface
subroutine amg_d_base_onelev_setsv(lv,val,info,pos) module subroutine amg_d_base_onelev_setsv(lv,val,info,pos)
import :: psb_dpk_, amg_d_onelev_type, amg_d_base_solver_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_d_onelev_type), target, intent(inout) :: lv class(amg_d_onelev_type), target, intent(inout) :: lv
class(amg_d_base_solver_type), intent(in) :: val class(amg_d_base_solver_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -370,12 +359,8 @@ module amg_d_onelev_mod
end interface end interface
interface interface
subroutine amg_d_base_onelev_setag(lv,val,info,pos) module subroutine amg_d_base_onelev_setag(lv,val,info,pos)
import :: psb_dpk_, amg_d_onelev_type, amg_d_base_aggregator_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_d_onelev_type), target, intent(inout) :: lv class(amg_d_onelev_type), target, intent(inout) :: lv
class(amg_d_base_aggregator_type), intent(in) :: val class(amg_d_base_aggregator_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -384,13 +369,8 @@ module amg_d_onelev_mod
end interface end interface
interface interface
subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx) module subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_d_onelev_type), intent(inout) :: lv class(amg_d_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(in) :: val
@@ -401,12 +381,8 @@ module amg_d_onelev_mod
end interface end interface
interface interface
subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx) module subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_d_onelev_type), intent(inout) :: lv class(amg_d_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what character(len=*), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
@@ -417,12 +393,8 @@ module amg_d_onelev_mod
end interface end interface
interface interface
subroutine amg_d_base_onelev_csetr(lv,what,val,info,pos,idx) module subroutine amg_d_base_onelev_csetr(lv,what,val,info,pos,idx)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
class(amg_d_onelev_type), intent(inout) :: lv class(amg_d_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what character(len=*), intent(in) :: what
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
@@ -433,11 +405,8 @@ module amg_d_onelev_mod
end interface end interface
interface interface
subroutine amg_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,& module subroutine amg_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
& solver,tprol,global_num) & solver,tprol,global_num)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none implicit none
class(amg_d_onelev_type), intent(in) :: lv class(amg_d_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
@@ -448,8 +417,7 @@ module amg_d_onelev_mod
end interface end interface
interface interface
subroutine amg_d_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work) module subroutine amg_d_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
import
implicit none implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv class(amg_d_onelev_type), target, intent(inout) :: lv
real(psb_dpk_), intent(in) :: alpha, beta real(psb_dpk_), intent(in) :: alpha, beta
@@ -458,8 +426,8 @@ module amg_d_onelev_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), optional :: work(:) real(psb_dpk_), optional :: work(:)
end subroutine amg_d_base_onelev_map_rstr_a end subroutine amg_d_base_onelev_map_rstr_a
subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty) module subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
import & work,vtx,vty)
implicit none implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv class(amg_d_onelev_type), target, intent(inout) :: lv
real(psb_dpk_), intent(in) :: alpha, beta real(psb_dpk_), intent(in) :: alpha, beta
@@ -471,8 +439,7 @@ module amg_d_onelev_mod
end interface end interface
interface interface
subroutine amg_d_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work) module subroutine amg_d_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
import
implicit none implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv class(amg_d_onelev_type), target, intent(inout) :: lv
real(psb_dpk_), intent(in) :: alpha, beta real(psb_dpk_), intent(in) :: alpha, beta
@@ -482,8 +449,8 @@ module amg_d_onelev_mod
real(psb_dpk_), optional :: work(:) real(psb_dpk_), optional :: work(:)
end subroutine amg_d_base_onelev_map_prol_a end subroutine amg_d_base_onelev_map_prol_a
subroutine amg_d_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty) module subroutine amg_d_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,&
import & work,vtx,vty)
implicit none implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv class(amg_d_onelev_type), target, intent(inout) :: lv
real(psb_dpk_), intent(in) :: alpha, beta real(psb_dpk_), intent(in) :: alpha, beta
@@ -494,6 +461,118 @@ module amg_d_onelev_mod
end subroutine amg_d_base_onelev_map_prol_v end subroutine amg_d_base_onelev_map_prol_v
end interface end interface
interface
module subroutine d_base_onelev_move_alloc(lv, b,info)
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv, b
integer(psb_ipk_), intent(out) :: info
end subroutine d_base_onelev_move_alloc
end interface
interface
module subroutine d_base_onelev_allocate_wrk(lv,info,vmold)
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold
end subroutine d_base_onelev_allocate_wrk
end interface
interface
module subroutine d_base_onelev_free_wrk(lv,info)
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine d_base_onelev_free_wrk
end interface
interface
module subroutine d_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
Implicit None
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold
type(psb_desc_type), intent(in), optional :: desc2
end subroutine d_wrk_alloc
end interface
interface
module subroutine d_inner_do_wrk_alloc(wk,nwv,desc,vmold)
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
class(psb_d_base_vect_type), intent(in), optional :: vmold
end subroutine d_inner_do_wrk_alloc
end interface
interface
module subroutine d_wrk_free(wk,info)
Implicit None
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
end subroutine d_wrk_free
end interface
interface
module subroutine d_wrk_clone(wk,wkout,info)
Implicit None
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
class(amg_dmlprec_wrk_type), target, intent(inout) :: wkout
integer(psb_ipk_), intent(out) :: info
end subroutine d_wrk_clone
end interface
interface
module subroutine d_wrk_move_alloc(wk, b,info)
implicit none
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk, b
integer(psb_ipk_), intent(out) :: info
end subroutine d_wrk_move_alloc
end interface
interface
module subroutine d_wrk_cnv(wk,info,vmold)
Implicit None
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold
end subroutine d_wrk_cnv
end interface
interface
module function d_wrk_sizeof(wk) result(val)
implicit none
class(amg_dmlprec_wrk_type), intent(in) :: wk
integer(psb_epk_) :: val
end function d_wrk_sizeof
end interface
interface
module subroutine d_remap_data_clone(rmp, remap_out, info)
implicit none
! Arguments
class(amg_d_remap_data_type), target, intent(inout) :: rmp
class(amg_d_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
end subroutine d_remap_data_clone
end interface
interface
module subroutine d_remap_move_alloc(rmp, remap_out, info)
implicit none
! Arguments
class(amg_d_remap_data_type), target, intent(inout) :: rmp
class(amg_d_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
end subroutine d_remap_move_alloc
end interface
contains contains
! !
! Function returning the size of the amg_prec_type data structure ! Function returning the size of the amg_prec_type data structure
@@ -619,7 +698,7 @@ contains
! Arguments ! Arguments
class(amg_d_onelev_type), target, intent(inout) :: lv class(amg_d_onelev_type), target, intent(inout) :: lv
class(amg_d_onelev_type), target, intent(inout) :: lvout class(amg_d_onelev_type), target, intent(inout) :: lvout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_ info = psb_success_
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
@@ -661,36 +740,6 @@ contains
end subroutine d_base_onelev_clone end subroutine d_base_onelev_clone
subroutine d_base_onelev_move_alloc(lv, b,info)
use psb_base_mod
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv, b
integer(psb_ipk_), intent(out) :: info
call b%free(info)
b%parms = lv%parms
b%szratio = lv%szratio
if (associated(lv%sm2,lv%sm2a)) then
call move_alloc(lv%sm,b%sm)
call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm2a
else
call move_alloc(lv%sm,b%sm)
call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm
end if
call move_alloc(lv%aggr,b%aggr)
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
b%base_a => lv%base_a
b%base_desc => lv%base_desc
end subroutine d_base_onelev_move_alloc
function d_base_onelev_get_wrksize(lv) result(val) function d_base_onelev_get_wrksize(lv) result(val)
implicit none implicit none
class(amg_d_onelev_type), intent(inout) :: lv class(amg_d_onelev_type), intent(inout) :: lv
@@ -728,269 +777,5 @@ contains
end function d_base_onelev_get_wrksize end function d_base_onelev_get_wrksize
subroutine d_base_onelev_allocate_wrk(lv,info,vmold)
use psb_base_mod
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: nwv, i
info = psb_success_
nwv = lv%get_wrksz()
if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
if (info == 0) then
if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
!
! Need to fix this, we need two different allocations
!
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold,&
& desc2=lv%remap_data%desc_ac_pre_remap)
else
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
end if
end if
end subroutine d_base_onelev_allocate_wrk
subroutine d_base_onelev_free_wrk(lv,info)
use psb_base_mod
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: nwv,i
info = psb_success_
if (allocated(lv%wrk)) then
call lv%wrk%free(info)
if (info == 0) deallocate(lv%wrk,stat=info)
end if
end subroutine d_base_onelev_free_wrk
subroutine d_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
use psb_base_mod
Implicit None
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold
type(psb_desc_type), intent(in), optional :: desc2
!
integer(psb_ipk_) :: i
info = psb_success_
call wk%free(info)
if (present(desc2)) then
!!$ write(0,*) 'Check on wrk_alloc 2',&
!!$ & desc2%get_local_rows(), desc%get_local_rows(),&
!!$ & desc2%get_local_cols(),desc%get_local_cols()
!!$ flush(0)
if (desc2%get_local_cols()>desc%get_local_cols()) then
call psb_geasb(wk%vx2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc2,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc2,info,&
& scratch=.true.,mold=vmold)
end do
else
!!$ write(0,*) 'Check on wrk_alloc 1.5 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
else
!!$ write(0,*) 'Check on wrk_alloc 1 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
end subroutine d_wrk_alloc
subroutine d_wrk_free(wk,info)
Implicit None
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
if (allocated(wk%tx)) deallocate(wk%tx, stat=info)
if (allocated(wk%ty)) deallocate(wk%ty, stat=info)
if (allocated(wk%x2l)) deallocate(wk%x2l, stat=info)
if (allocated(wk%y2l)) deallocate(wk%y2l, stat=info)
call wk%vtx%free(info)
call wk%vty%free(info)
call wk%vx2l%free(info)
call wk%vy2l%free(info)
if (allocated(wk%wv)) then
do i=1,size(wk%wv)
call wk%wv(i)%free(info)
end do
deallocate(wk%wv, stat=info)
end if
end subroutine d_wrk_free
subroutine d_wrk_clone(wk,wkout,info)
use psb_base_mod
Implicit None
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
class(amg_dmlprec_wrk_type), target, intent(inout) :: wkout
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call psb_safe_ab_cpy(wk%tx,wkout%tx,info)
call psb_safe_ab_cpy(wk%ty,wkout%ty,info)
call psb_safe_ab_cpy(wk%x2l,wkout%x2l,info)
call psb_safe_ab_cpy(wk%y2l,wkout%y2l,info)
call wk%vtx%clone(wkout%vtx,info)
call wk%vty%clone(wkout%vty,info)
call wk%vx2l%clone(wkout%vx2l,info)
call wk%vy2l%clone(wkout%vy2l,info)
if (allocated(wkout%wv)) then
do i=1,size(wkout%wv)
call wkout%wv(i)%free(info)
end do
deallocate( wkout%wv)
end if
allocate(wkout%wv(size(wk%wv)),stat=info)
do i=1,size(wk%wv)
call wk%wv(i)%clone(wkout%wv(i),info)
end do
return
end subroutine d_wrk_clone
subroutine d_wrk_move_alloc(wk, b,info)
implicit none
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk, b
integer(psb_ipk_), intent(out) :: info
call b%free(info)
call move_alloc(wk%tx,b%tx)
call move_alloc(wk%ty,b%ty)
call move_alloc(wk%x2l,b%x2l)
call move_alloc(wk%y2l,b%y2l)
!
! Should define V%move_alloc....
call move_alloc(wk%vtx%v,b%vtx%v)
call move_alloc(wk%vty%v,b%vty%v)
call move_alloc(wk%vx2l%v,b%vx2l%v)
call move_alloc(wk%vy2l%v,b%vy2l%v)
call move_alloc(wk%wv,b%wv)
end subroutine d_wrk_move_alloc
subroutine d_wrk_cnv(wk,info,vmold)
use psb_base_mod
Implicit None
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: i
info = psb_success_
if (present(vmold)) then
call wk%vtx%cnv(vmold)
call wk%vty%cnv(vmold)
call wk%vx2l%cnv(vmold)
call wk%vy2l%cnv(vmold)
if (allocated(wk%wv)) then
do i=1,size(wk%wv)
call wk%wv(i)%cnv(vmold)
end do
end if
end if
end subroutine d_wrk_cnv
function d_wrk_sizeof(wk) result(val)
use psb_realloc_mod
implicit none
class(amg_dmlprec_wrk_type), intent(in) :: wk
integer(psb_epk_) :: val
integer :: i
val = 0
val = val + (1_psb_epk_ * psb_sizeof_dp) * psb_size(wk%tx)
val = val + (1_psb_epk_ * psb_sizeof_dp) * psb_size(wk%ty)
val = val + (1_psb_epk_ * psb_sizeof_dp) * psb_size(wk%x2l)
val = val + (1_psb_epk_ * psb_sizeof_dp) * psb_size(wk%y2l)
val = val + wk%vtx%sizeof()
val = val + wk%vty%sizeof()
val = val + wk%vx2l%sizeof()
val = val + wk%vy2l%sizeof()
if (allocated(wk%wv)) then
do i=1, size(wk%wv)
val = val + wk%wv(i)%sizeof()
end do
end if
end function d_wrk_sizeof
subroutine d_remap_data_clone(rmp, remap_out, info)
use psb_base_mod
implicit none
! Arguments
class(amg_d_remap_data_type), target, intent(inout) :: rmp
class(amg_d_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
if (info == psb_success_) &
& call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
remap_out%idest = rmp%idest
call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
end subroutine d_remap_data_clone
end module amg_d_onelev_mod end module amg_d_onelev_mod
+11 -18
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -54,7 +54,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -119,10 +119,6 @@
module amg_d_parmatch_aggregator_mod module amg_d_parmatch_aggregator_mod
use amg_d_base_aggregator_mod use amg_d_base_aggregator_mod
use amg_d_matchboxp_mod use amg_d_matchboxp_mod
#if defined(SERIAL_MPI)
type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type
end type amg_d_parmatch_aggregator_type
#else
type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type
integer(psb_ipk_) :: matching_alg integer(psb_ipk_) :: matching_alg
integer(psb_ipk_) :: n_sweeps ! When n_sweeps >1 we need an auxiliary descriptor integer(psb_ipk_) :: n_sweeps ! When n_sweeps >1 we need an auxiliary descriptor
@@ -140,7 +136,7 @@ module amg_d_parmatch_aggregator_mod
procedure, pass(ag) :: mat_bld => amg_d_parmatch_aggregator_mat_bld procedure, pass(ag) :: mat_bld => amg_d_parmatch_aggregator_mat_bld
procedure, pass(ag) :: mat_asb => amg_d_parmatch_aggregator_mat_asb procedure, pass(ag) :: mat_asb => amg_d_parmatch_aggregator_mat_asb
procedure, pass(ag) :: inner_mat_asb => amg_d_parmatch_aggregator_inner_mat_asb procedure, pass(ag) :: inner_mat_asb => amg_d_parmatch_aggregator_inner_mat_asb
procedure, pass(ag) :: bld_map => amg_d_parmatch_aggregator_bld_map procedure, pass(ag) :: bld_linmap => amg_d_parmatch_aggregator_bld_linmap
procedure, pass(ag) :: csetc => amg_d_parmatch_aggr_csetc procedure, pass(ag) :: csetc => amg_d_parmatch_aggr_csetc
procedure, pass(ag) :: cseti => amg_d_parmatch_aggr_cseti procedure, pass(ag) :: cseti => amg_d_parmatch_aggr_cseti
procedure, pass(ag) :: default => amg_d_parmatch_aggr_set_default procedure, pass(ag) :: default => amg_d_parmatch_aggr_set_default
@@ -400,6 +396,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_ character(1024) :: prefix_
info = psb_success_
if (present(prefix)) then if (present(prefix)) then
prefix_ = prefix prefix_ = prefix
else else
@@ -451,6 +448,7 @@ contains
class(amg_d_base_aggregator_type), target, intent(inout) :: agnext class(amg_d_base_aggregator_type), target, intent(inout) :: agnext
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_
! !
! !
select type(agnext) select type(agnext)
@@ -590,7 +588,7 @@ contains
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = 0 info = psb_success_
if ((info == 0).and.allocated(ag%w)) deallocate(ag%w,stat=info) if ((info == 0).and.allocated(ag%w)) deallocate(ag%w,stat=info)
if ((info == 0).and.allocated(ag%w_nxt)) deallocate(ag%w_nxt,stat=info) if ((info == 0).and.allocated(ag%w_nxt)) deallocate(ag%w_nxt,stat=info)
if ((info == 0).and.allocated(ag%prol)) then if ((info == 0).and.allocated(ag%prol)) then
@@ -629,7 +627,7 @@ contains
class(amg_d_base_aggregator_type), allocatable, intent(inout) :: agnext class(amg_d_base_aggregator_type), allocatable, intent(inout) :: agnext
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = 0 info = psb_success_
if (allocated(agnext)) then if (allocated(agnext)) then
call agnext%free(info) call agnext%free(info)
if (info == 0) deallocate(agnext,stat=info) if (info == 0) deallocate(agnext,stat=info)
@@ -645,7 +643,7 @@ contains
end select end select
end subroutine amg_d_parmatch_aggregator_clone end subroutine amg_d_parmatch_aggregator_clone
subroutine amg_d_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,& subroutine amg_d_parmatch_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
& op_restr,op_prol,map,info) & op_restr,op_prol,map,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
@@ -656,8 +654,9 @@ contains
type(psb_dlinmap_type), intent(out) :: map type(psb_dlinmap_type), intent(out) :: map
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='d_parmatch_aggregator_bld_map' character(len=20) :: name='d_parmatch_aggregator_bld_linmap'
info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! !
! Copy the prolongation/restriction matrices into the descriptor map. ! Copy the prolongation/restriction matrices into the descriptor map.
@@ -675,17 +674,11 @@ contains
map = psb_linmap(psb_map_gen_linear_,desc_a,& map = psb_linmap(psb_map_gen_linear_,desc_a,&
& desc_ac,op_restr,op_prol,ilaggr,nlaggr) & desc_ac,op_restr,op_prol,ilaggr,nlaggr)
end if end if
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
goto 9999
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine amg_d_parmatch_aggregator_bld_map end subroutine amg_d_parmatch_aggregator_bld_linmap
#endif
end module amg_d_parmatch_aggregator_mod end module amg_d_parmatch_aggregator_mod
+1 -1
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -140,7 +140,7 @@ module amg_d_poly_smoother
import :: psb_desc_type, amg_d_poly_smoother_type, psb_d_vect_type, psb_dpk_, & import :: psb_desc_type, amg_d_poly_smoother_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,& & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_poly_smoother_type), intent(inout) :: sm class(amg_d_poly_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+1 -1
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+48 -40
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -102,6 +102,7 @@ module amg_d_prec_type
! The multilevel hierarchy ! The multilevel hierarchy
! !
type(amg_d_onelev_type), allocatable :: precv(:) type(amg_d_onelev_type), allocatable :: precv(:)
integer(psb_ipk_) :: nlevs
contains contains
procedure, pass(prec) :: psb_d_apply2_vect => amg_d_apply2_vect procedure, pass(prec) :: psb_d_apply2_vect => amg_d_apply2_vect
procedure, pass(prec) :: psb_d_apply1_vect => amg_d_apply1_vect procedure, pass(prec) :: psb_d_apply1_vect => amg_d_apply1_vect
@@ -113,11 +114,13 @@ module amg_d_prec_type
procedure, pass(prec) :: free => amg_d_prec_free procedure, pass(prec) :: free => amg_d_prec_free
procedure, pass(prec) :: allocate_wrk => amg_d_allocate_wrk procedure, pass(prec) :: allocate_wrk => amg_d_allocate_wrk
procedure, pass(prec) :: free_wrk => amg_d_free_wrk procedure, pass(prec) :: free_wrk => amg_d_free_wrk
procedure, pass(prec) :: deallocate_wrk => amg_d_free_wrk
procedure, pass(prec) :: is_allocated_wrk => amg_d_is_allocated_wrk procedure, pass(prec) :: is_allocated_wrk => amg_d_is_allocated_wrk
procedure, pass(prec) :: get_complexity => amg_d_get_compl procedure, pass(prec) :: get_complexity => amg_d_get_compl
procedure, pass(prec) :: cmp_complexity => amg_d_cmp_compl procedure, pass(prec) :: cmp_complexity => amg_d_cmp_compl
procedure, pass(prec) :: get_avg_cr => amg_d_get_avg_cr procedure, pass(prec) :: get_avg_cr => amg_d_get_avg_cr
procedure, pass(prec) :: cmp_avg_cr => amg_d_cmp_avg_cr procedure, pass(prec) :: cmp_avg_cr => amg_d_cmp_avg_cr
procedure, pass(prec) :: set_nlevs => amg_d_set_nlevs
procedure, pass(prec) :: get_nlevs => amg_d_get_nlevs procedure, pass(prec) :: get_nlevs => amg_d_get_nlevs
procedure, pass(prec) :: get_nzeros => amg_d_get_nzeros procedure, pass(prec) :: get_nzeros => amg_d_get_nzeros
procedure, pass(prec) :: sizeof => amg_dprec_sizeof procedure, pass(prec) :: sizeof => amg_dprec_sizeof
@@ -310,7 +313,7 @@ module amg_d_prec_type
& psb_d_base_sparse_mat, psb_d_base_vect_type, & & psb_d_base_sparse_mat, psb_d_base_vect_type, &
& psb_i_base_vect_type, amg_dprec_type, psb_ipk_ & psb_i_base_vect_type, amg_dprec_type, psb_ipk_
implicit none implicit none
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
class(amg_dprec_type), intent(inout), target :: prec class(amg_dprec_type), intent(inout), target :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -322,14 +325,15 @@ module amg_d_prec_type
end interface amg_precbld end interface amg_precbld
interface amg_hierarchy_bld interface amg_hierarchy_bld
subroutine amg_d_hierarchy_bld(a,desc_a,prec,info) subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
& amg_dprec_type, psb_ipk_ & amg_dprec_type, psb_ipk_
implicit none implicit none
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
class(amg_dprec_type), intent(inout), target :: prec class(amg_dprec_type), intent(inout), target :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: cpymat
! character, intent(in),optional :: upd ! character, intent(in),optional :: upd
end subroutine amg_d_hierarchy_bld end subroutine amg_d_hierarchy_bld
end interface amg_hierarchy_bld end interface amg_hierarchy_bld
@@ -433,10 +437,19 @@ contains
class(amg_dprec_type), intent(in) :: prec class(amg_dprec_type), intent(in) :: prec
integer(psb_ipk_) :: val integer(psb_ipk_) :: val
val = 0 val = 0
if (allocated(prec%precv)) then !!$ if (allocated(prec%precv)) then
val = size(prec%precv) !!$ val = size(prec%precv)
end if !!$ end if
val = prec%nlevs
!!$ write(0,*) ' NLEVS: ',prec%nlevs, val,size(prec%precv)
end function amg_d_get_nlevs end function amg_d_get_nlevs
subroutine amg_d_set_nlevs(prec,nl)
implicit none
class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_) :: nl
prec%nlevs = nl
end subroutine amg_d_set_nlevs
! !
! Function returning the size of the amg_prec_type data structure ! Function returning the size of the amg_prec_type data structure
! in bytes or in number of nonzeros of the operator(s) involved. ! in bytes or in number of nonzeros of the operator(s) involved.
@@ -507,7 +520,7 @@ contains
real(psb_dpk_) :: num, den, nmin real(psb_dpk_) :: num, den, nmin
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il integer(psb_ipk_) :: il,nl
num = -done num = -done
den = done den = done
@@ -517,7 +530,10 @@ contains
num = prec%precv(il)%base_a%get_nzeros() num = prec%precv(il)%base_a%get_nzeros()
if (num >= dzero) then if (num >= dzero) then
den = num den = num
do il=2,size(prec%precv) nl = prec%get_nlevs()
!!$ write(0,*) 'Inside cmp_compl ',nl,size(prec%precv)
do il=2, nl
!!$ write(0,*) ' ',il,associated(prec%precv(il)%base_a)
num = num + max(0,prec%precv(il)%base_a%get_nzeros()) num = num + max(0,prec%precv(il)%base_a%get_nzeros())
end do end do
end if end if
@@ -548,7 +564,6 @@ contains
end function amg_d_get_avg_cr end function amg_d_get_avg_cr
subroutine amg_d_cmp_avg_cr(prec) subroutine amg_d_cmp_avg_cr(prec)
implicit none implicit none
class(amg_dprec_type), intent(inout) :: prec class(amg_dprec_type), intent(inout) :: prec
@@ -556,17 +571,18 @@ contains
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il, nl, iam, np integer(psb_ipk_) :: il, nl, iam, np
avgcr = dzero avgcr = dzero
nl = prec%get_nlevs()
do il=2,nl
if (prec%precv(il)%base_desc%is_ok()) then
ctxt = prec%precv(il)%base_desc%get_ctxt()
call psb_info(ctxt,iam,np)
if (iam >=0) avgcr = avgcr + max(dzero,prec%precv(il)%szratio)
end if
end do
avgcr = avgcr / (nl-1)
ctxt = prec%ctxt ctxt = prec%ctxt
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
if (allocated(prec%precv)) then
nl = size(prec%precv)
do il=2,nl
avgcr = avgcr + max(dzero,prec%precv(il)%szratio)
end do
avgcr = avgcr / (nl-1)
end if
call psb_sum(ctxt,avgcr) call psb_sum(ctxt,avgcr)
prec%ag_data%avg_cr = avgcr/np prec%ag_data%avg_cr = avgcr/np
end subroutine amg_d_cmp_avg_cr end subroutine amg_d_cmp_avg_cr
@@ -584,9 +600,7 @@ contains
! error code. ! error code.
! !
subroutine amg_dprecfree(p,info) subroutine amg_dprecfree(p,info)
implicit none implicit none
! Arguments ! Arguments
type(amg_dprec_type), intent(inout) :: p type(amg_dprec_type), intent(inout) :: p
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -612,9 +626,7 @@ contains
end subroutine amg_dprecfree end subroutine amg_dprecfree
subroutine amg_d_prec_free(prec,info) subroutine amg_d_prec_free(prec,info)
implicit none implicit none
! Arguments ! Arguments
class(amg_dprec_type), intent(inout) :: prec class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -634,6 +646,11 @@ contains
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
do i=1,size(prec%precv) do i=1,size(prec%precv)
call prec%precv(i)%free(info) call prec%precv(i)%free(info)
if (psb_errstatus_fatal()) then
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
end do end do
deallocate(prec%precv,stat=info) deallocate(prec%precv,stat=info)
end if end if
@@ -646,9 +663,7 @@ contains
end subroutine amg_d_prec_free end subroutine amg_d_prec_free
subroutine amg_d_smoothers_free(prec,info) subroutine amg_d_smoothers_free(prec,info)
implicit none implicit none
! Arguments ! Arguments
class(amg_dprec_type), intent(inout) :: prec class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -665,7 +680,7 @@ contains
end if end if
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
do i=1,size(prec%precv) do i=1,prec%get_nlevs()
call prec%precv(i)%free_smoothers(info) call prec%precv(i)%free_smoothers(info)
end do end do
end if end if
@@ -679,9 +694,7 @@ contains
end subroutine amg_d_smoothers_free end subroutine amg_d_smoothers_free
subroutine amg_d_hierarchy_free(prec,info) subroutine amg_d_hierarchy_free(prec,info)
implicit none implicit none
! Arguments ! Arguments
class(amg_dprec_type), intent(inout) :: prec class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -708,7 +721,6 @@ contains
end subroutine amg_d_hierarchy_free end subroutine amg_d_hierarchy_free
! !
! Top level methods. ! Top level methods.
! !
@@ -773,7 +785,6 @@ contains
end subroutine amg_d_apply1_vect end subroutine amg_d_apply1_vect
subroutine amg_d_apply2v(prec,x,y,desc_data,info,trans,work) subroutine amg_d_apply2v(prec,x,y,desc_data,info,trans,work)
implicit none implicit none
type(psb_desc_type),intent(in) :: desc_data type(psb_desc_type),intent(in) :: desc_data
@@ -838,7 +849,6 @@ contains
subroutine amg_d_dump(prec,info,istart,iend,iproc,prefix,head,& subroutine amg_d_dump(prec,info,istart,iend,iproc,prefix,head,&
& ac,rp,smoother,solver,tprol,& & ac,rp,smoother,solver,tprol,&
& global_num) & global_num)
implicit none implicit none
class(amg_dprec_type), intent(in) :: prec class(amg_dprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -855,7 +865,7 @@ contains
info = 0 info = 0
ctxt = prec%ctxt ctxt = prec%ctxt
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
iln = size(prec%precv) iln = prec%get_nlevs()
if (present(istart)) then if (present(istart)) then
il1 = max(1,istart) il1 = max(1,istart)
else else
@@ -879,7 +889,6 @@ contains
end subroutine amg_d_dump end subroutine amg_d_dump
subroutine amg_d_cnv(prec,info,amold,vmold,imold) subroutine amg_d_cnv(prec,info,amold,vmold,imold)
implicit none implicit none
class(amg_dprec_type), intent(inout) :: prec class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -891,7 +900,7 @@ contains
info = psb_success_ info = psb_success_
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
do i=1,size(prec%precv) do i=1,prec%get_nlevs()
if (info == psb_success_ ) & if (info == psb_success_ ) &
& call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold) & call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold)
end do end do
@@ -900,7 +909,6 @@ contains
end subroutine amg_d_cnv end subroutine amg_d_cnv
subroutine amg_d_clone(prec,precout,info) subroutine amg_d_clone(prec,precout,info)
implicit none implicit none
class(amg_dprec_type), intent(inout) :: prec class(amg_dprec_type), intent(inout) :: prec
class(psb_dprec_type), intent(inout) :: precout class(psb_dprec_type), intent(inout) :: precout
@@ -912,7 +920,6 @@ contains
end subroutine amg_d_clone end subroutine amg_d_clone
subroutine amg_d_inner_clone(prec,precout,info) subroutine amg_d_inner_clone(prec,precout,info)
implicit none implicit none
class(amg_dprec_type), intent(inout) :: prec class(amg_dprec_type), intent(inout) :: prec
class(psb_dprec_type), target, intent(inout) :: precout class(psb_dprec_type), target, intent(inout) :: precout
@@ -928,8 +935,9 @@ contains
pout%ctxt = prec%ctxt pout%ctxt = prec%ctxt
pout%ag_data = prec%ag_data pout%ag_data = prec%ag_data
pout%outer_sweeps = prec%outer_sweeps pout%outer_sweeps = prec%outer_sweeps
pout%nlevs = prec%nlevs
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
ln = size(prec%precv) ln = prec%get_nlevs()
allocate(pout%precv(ln),stat=info) allocate(pout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
if (ln >= 1) then if (ln >= 1) then
@@ -937,6 +945,7 @@ contains
end if end if
do lev=2, ln do lev=2, ln
if (info /= psb_success_) exit if (info /= psb_success_) exit
!!$ write(0,*) 'Inner_clone must be checked and reimplemented! '
call prec%precv(lev)%clone(pout%precv(lev),info) call prec%precv(lev)%clone(pout%precv(lev),info)
if (info == psb_success_) then if (info == psb_success_) then
pout%precv(lev)%base_a => pout%precv(lev)%ac pout%precv(lev)%base_a => pout%precv(lev)%ac
@@ -1001,7 +1010,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
! !
! In MLD the DESC optional argument is ignored, since ! In AMG the DESC optional argument is ignored, since
! the necessary info is contained in the various entries of the ! the necessary info is contained in the various entries of the
! PRECV component. ! PRECV component.
type(psb_desc_type), intent(in), optional :: desc type(psb_desc_type), intent(in), optional :: desc
@@ -1016,7 +1025,7 @@ contains
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999 info = psb_err_internal_error_; goto 9999
end if end if
nlev = size(prec%precv) nlev = prec%get_nlevs()
level = 1 level = 1
do level = 1, nlev do level = 1, nlev
call prec%precv(level)%allocate_wrk(info,vmold=vmold) call prec%precv(level)%allocate_wrk(info,vmold=vmold)
@@ -1039,7 +1048,6 @@ contains
subroutine amg_d_free_wrk(prec,info) subroutine amg_d_free_wrk(prec,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
! Arguments ! Arguments
class(amg_dprec_type), intent(inout) :: prec class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -1056,7 +1064,7 @@ contains
end if end if
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
nlev = size(prec%precv) nlev = prec%get_nlevs()
do level = 1, nlev do level = 1, nlev
call prec%precv(level)%free_wrk(info) call prec%precv(level)%free_wrk(info)
end do end do
+263 -207
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -51,7 +51,7 @@ module amg_d_slu_solver
use iso_c_binding use iso_c_binding
use amg_d_base_solver_mod use amg_d_base_solver_mod
#if defined(IPK8) #if defined(PSB_IPK8)
type, extends(amg_d_base_solver_type) :: amg_d_slu_solver_type type, extends(amg_d_base_solver_type) :: amg_d_slu_solver_type
@@ -63,9 +63,9 @@ module amg_d_slu_solver
type(c_ptr) :: lufactors=c_null_ptr type(c_ptr) :: lufactors=c_null_ptr
integer(c_long_long) :: symbsize=0, numsize=0 integer(c_long_long) :: symbsize=0, numsize=0
contains contains
procedure, pass(sv) :: build => d_slu_solver_bld procedure, pass(sv) :: build => amg_d_slu_solver_bld
procedure, pass(sv) :: apply_a => d_slu_solver_apply procedure, pass(sv) :: apply_a => amg_d_slu_solver_apply
procedure, pass(sv) :: apply_v => d_slu_solver_apply_vect procedure, pass(sv) :: apply_v => amg_d_slu_solver_apply_vect
procedure, pass(sv) :: free => d_slu_solver_free procedure, pass(sv) :: free => d_slu_solver_free
procedure, pass(sv) :: clear_data => d_slu_solver_clear_data procedure, pass(sv) :: clear_data => d_slu_solver_clear_data
procedure, pass(sv) :: descr => d_slu_solver_descr procedure, pass(sv) :: descr => d_slu_solver_descr
@@ -76,9 +76,8 @@ module amg_d_slu_solver
end type amg_d_slu_solver_type end type amg_d_slu_solver_type
private :: d_slu_solver_bld, d_slu_solver_apply, & private :: d_slu_solver_free, d_slu_solver_descr, &
& d_slu_solver_free, d_slu_solver_descr, & & d_slu_solver_sizeof, &
& d_slu_solver_sizeof, d_slu_solver_apply_vect, &
& d_slu_solver_get_fmt, d_slu_solver_get_id, & & d_slu_solver_get_fmt, d_slu_solver_get_id, &
& d_slu_solver_clear_data & d_slu_solver_clear_data
private :: d_slu_solver_finalize private :: d_slu_solver_finalize
@@ -118,207 +117,264 @@ module amg_d_slu_solver
end function amg_dslu_free end function amg_dslu_free
end interface end interface
interface
subroutine amg_d_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
use psb_base_mod
import amg_d_slu_solver_type
Implicit None
! Arguments
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_slu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_d_slu_solver_bld
end interface
interface
subroutine amg_d_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,wv,info,init,initu)
use psb_base_mod
import amg_d_slu_solver_type
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(amg_d_slu_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu
end subroutine amg_d_slu_solver_apply_vect
end interface
interface
subroutine amg_d_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
use psb_base_mod
import amg_d_slu_solver_type
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(amg_d_slu_solver_type), intent(inout) :: sv
real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
real(psb_dpk_),intent(inout), optional :: initu(:)
end subroutine amg_d_slu_solver_apply
end interface
contains contains
subroutine d_slu_solver_apply(alpha,sv,x,beta,y,desc_data,& !!$ subroutine d_slu_solver_apply(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu) !!$ & trans,work,info,init,initu)
use psb_base_mod !!$ use psb_base_mod
implicit none !!$ implicit none
type(psb_desc_type), intent(in) :: desc_data !!$ type(psb_desc_type), intent(in) :: desc_data
class(amg_d_slu_solver_type), intent(inout) :: sv !!$ class(amg_d_slu_solver_type), intent(inout) :: sv
real(psb_dpk_),intent(inout) :: x(:) !!$ real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) !!$ real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta !!$ real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans !!$ character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:) !!$ real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info !!$ integer, intent(out) :: info
character, intent(in), optional :: init !!$ character, intent(in), optional :: init
real(psb_dpk_),intent(inout), optional :: initu(:) !!$ real(psb_dpk_),intent(inout), optional :: initu(:)
!!$
integer :: n_row,n_col !!$ integer :: n_row,n_col
real(psb_dpk_), pointer :: ww(:) !!$ real(psb_dpk_), pointer :: ww(:)
type(psb_ctxt_type) :: ctxt !!$ type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act !!$ integer :: np,me,i, err_act
character :: trans_ !!$ character :: trans_
character(len=20) :: name='d_slu_solver_apply' !!$ character(len=20) :: name='d_slu_solver_apply'
!!$
call psb_erractionsave(err_act) !!$ call psb_erractionsave(err_act)
!!$
info = psb_success_ !!$ info = psb_success_
!!$
trans_ = psb_toupper(trans) !!$ trans_ = psb_toupper(trans)
select case(trans_) !!$ select case(trans_)
case('N') !!$ case('N')
case('T','C') !!$ case('T','C')
case default !!$ case default
call psb_errpush(psb_err_iarg_invalid_i_,name) !!$ call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999 !!$ goto 9999
end select !!$ end select
! !!$ !
! For non-iterative solvers, init and initu are ignored. !!$ ! For non-iterative solvers, init and initu are ignored.
! !!$ !
!!$
n_row = desc_data%get_local_rows() !!$ n_row = desc_data%get_local_rows()
n_col = desc_data%get_local_cols() !!$ n_col = desc_data%get_local_cols()
!!$
if (n_col <= size(work)) then !!$ if (n_col <= size(work)) then
ww => work(1:n_col) !!$ ww => work(1:n_col)
else !!$ else
allocate(ww(n_col),stat=info) !!$ allocate(ww(n_col),stat=info)
if (info /= psb_success_) then !!$ if (info /= psb_success_) then
info=psb_err_alloc_request_ !!$ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),& !!$ call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
& a_err='real(psb_dpk_)') !!$ & a_err='real(psb_dpk_)')
goto 9999 !!$ goto 9999
end if !!$ end if
endif !!$ endif
!!$
ww(1:n_row) = x(1:n_row) !!$ ww(1:n_row) = x(1:n_row)
select case(trans_) !!$ select case(trans_)
case('N') !!$ case('N')
info = amg_dslu_solve(0,n_row,1,ww,n_row,sv%lufactors) !!$ info = amg_dslu_solve(0,n_row,1,ww,n_row,sv%lufactors)
case('T') !!$ case('T')
info = amg_dslu_solve(1,n_row,1,ww,n_row,sv%lufactors) !!$ info = amg_dslu_solve(1,n_row,1,ww,n_row,sv%lufactors)
case('C') !!$ case('C')
info = amg_dslu_solve(2,n_row,1,ww,n_row,sv%lufactors) !!$ info = amg_dslu_solve(2,n_row,1,ww,n_row,sv%lufactors)
case default !!$ case default
call psb_errpush(psb_err_internal_error_, & !!$ call psb_errpush(psb_err_internal_error_, &
& name,a_err='Invalid TRANS in ILU subsolve') !!$ & name,a_err='Invalid TRANS in ILU subsolve')
goto 9999 !!$ goto 9999
end select !!$ end select
!!$
if (info == psb_success_) & !!$ if (info == psb_success_) &
& call psb_geaxpby(alpha,ww,beta,y,desc_data,info) !!$ & call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
!!$
!!$
if (info /= psb_success_) then !!$ if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,& !!$ call psb_errpush(psb_err_internal_error_,&
& name,a_err='Error in subsolve') !!$ & name,a_err='Error in subsolve')
goto 9999 !!$ goto 9999
endif !!$ endif
!!$
if (n_col > size(work)) then !!$ if (n_col > size(work)) then
deallocate(ww) !!$ deallocate(ww)
endif !!$ endif
!!$
call psb_erractionrestore(err_act) !!$ call psb_erractionrestore(err_act)
return !!$ return
!!$
9999 call psb_error_handler(err_act) !!$9999 call psb_error_handler(err_act)
return !!$ return
!!$
end subroutine d_slu_solver_apply !!$ end subroutine d_slu_solver_apply
!!$
subroutine d_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& !!$ subroutine d_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,wv,info,init,initu) !!$ & trans,work,wv,info,init,initu)
use psb_base_mod !!$ use psb_base_mod
implicit none !!$ implicit none
type(psb_desc_type), intent(in) :: desc_data !!$ type(psb_desc_type), intent(in) :: desc_data
class(amg_d_slu_solver_type), intent(inout) :: sv !!$ class(amg_d_slu_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x !!$ type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y !!$ type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta !!$ real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans !!$ character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:) !!$ real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:) !!$ type(psb_d_vect_type),intent(inout) :: wv(:)
integer, intent(out) :: info !!$ integer, intent(out) :: info
character, intent(in), optional :: init !!$ character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu !!$ type(psb_d_vect_type),intent(inout), optional :: initu
!!$
integer :: err_act !!$ integer :: err_act
character(len=20) :: name='d_slu_solver_apply_vect' !!$ character(len=20) :: name='d_slu_solver_apply_vect'
!!$
call psb_erractionsave(err_act) !!$ call psb_erractionsave(err_act)
!!$
info = psb_success_ !!$ info = psb_success_
! !!$ !
! For non-iterative solvers, init and initu are ignored. !!$ ! For non-iterative solvers, init and initu are ignored.
! !!$ !
!!$
call x%v%sync() !!$ call x%v%sync()
call y%v%sync() !!$ call y%v%sync()
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info) !!$ call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
call y%v%set_host() !!$ call y%v%set_host()
if (info /= 0) goto 9999 !!$ if (info /= 0) goto 9999
!!$
call psb_erractionrestore(err_act) !!$ call psb_erractionrestore(err_act)
return !!$ return
!!$
9999 call psb_error_handler(err_act) !!$9999 call psb_error_handler(err_act)
return !!$ return
!!$
end subroutine d_slu_solver_apply_vect !!$ end subroutine d_slu_solver_apply_vect
!!$
subroutine d_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) !!$ subroutine d_slu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
!!$
use psb_base_mod !!$ use psb_base_mod
!!$
Implicit None !!$ Implicit None
!!$
! Arguments !!$ ! Arguments
type(psb_dspmat_type), intent(in), target :: a !!$ type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a !!$ Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_slu_solver_type), intent(inout) :: sv !!$ class(amg_d_slu_solver_type), intent(inout) :: sv
integer, intent(out) :: info !!$ integer, intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b !!$ type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold !!$ class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold !!$ class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold !!$ class(psb_i_base_vect_type), intent(in), optional :: imold
! Local variables !!$ ! Local variables
type(psb_dspmat_type) :: atmp !!$ type(psb_dspmat_type) :: atmp
type(psb_d_csc_sparse_mat) :: acsc !!$ type(psb_d_csc_sparse_mat) :: acsc
type(psb_d_coo_sparse_mat) :: acoo !!$ type(psb_d_coo_sparse_mat) :: acoo
integer :: n_row,n_col, nrow_a, nztota !!$ integer :: n_row,n_col, nrow_a, nztota
type(psb_ctxt_type) :: ctxt !!$ type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act, debug_unit, debug_level !!$ integer :: np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_slu_solver_bld', ch_err !!$ character(len=20) :: name='d_slu_solver_bld', ch_err
!!$
info=psb_success_ !!$ info=psb_success_
call psb_erractionsave(err_act) !!$ call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() !!$ debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() !!$ debug_level = psb_get_debug_level()
ctxt = desc_a%get_context() !!$ ctxt = desc_a%get_context()
call psb_info(ctxt, me, np) !!$ call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) & !!$ if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' start' !!$ & write(debug_unit,*) me,' ',trim(name),' start'
!!$
!!$
n_row = desc_a%get_local_rows() !!$ n_row = desc_a%get_local_rows()
n_col = desc_a%get_local_cols() !!$ n_col = desc_a%get_local_cols()
!!$
!!$
call a%cscnv(atmp,info,type='coo') !!$ call a%cscnv(atmp,info,type='coo')
call psb_rwextd(n_row,atmp,info,b=b) !!$ call psb_rwextd(n_row,atmp,info,b=b)
call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_) !!$ call atmp%cscnv(info,type='coo',dupl=psb_dupl_add_)
nrow_a = atmp%get_nrows() !!$ nrow_a = atmp%get_nrows()
call atmp%a%csclip(acoo,info,jmax=nrow_a) !!$ call atmp%a%csclip(acoo,info,jmax=nrow_a)
call acsc%mv_from_coo(acoo,info) !!$ call acsc%mv_from_coo(acoo,info)
nztota = acsc%get_nzeros() !!$ nztota = acsc%get_nzeros()
! Fix the entries to call C-base SuperLU !!$ ! Fix the entries to call C-base SuperLU
acsc%ia(:) = acsc%ia(:) - 1 !!$ acsc%ia(:) = acsc%ia(:) - 1
acsc%icp(:) = acsc%icp(:) - 1 !!$ acsc%icp(:) = acsc%icp(:) - 1
info = amg_dslu_fact(nrow_a,nztota,acsc%val,& !!$ info = amg_dslu_fact(nrow_a,nztota,acsc%val,&
& acsc%icp,acsc%ia,sv%lufactors) !!$ & acsc%icp,acsc%ia,sv%lufactors)
!!$
if (info /= psb_success_) then !!$ if (info /= psb_success_) then
info=psb_err_from_subroutine_ !!$ info=psb_err_from_subroutine_
ch_err='amg_dslu_fact' !!$ ch_err='amg_dslu_fact'
call psb_errpush(info,name,a_err=ch_err) !!$ call psb_errpush(info,name,a_err=ch_err)
goto 9999 !!$ goto 9999
end if !!$ end if
!!$
call acsc%free() !!$ call acsc%free()
call atmp%free() !!$ call atmp%free()
!!$
if (debug_level >= psb_debug_outer_) & !!$ if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' end' !!$ & write(debug_unit,*) me,' ',trim(name),' end'
!!$
call psb_erractionrestore(err_act) !!$ call psb_erractionrestore(err_act)
return !!$ return
!!$
9999 call psb_error_handler(err_act) !!$9999 call psb_error_handler(err_act)
return !!$ return
end subroutine d_slu_solver_bld !!$ end subroutine d_slu_solver_bld
subroutine d_slu_solver_free(sv,info) subroutine d_slu_solver_free(sv,info)
+3 -3
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -52,7 +52,7 @@ module amg_d_sludist_solver
use iso_c_binding use iso_c_binding
use amg_d_base_solver_mod use amg_d_base_solver_mod
#if (!defined(HAVE_SLUDIST_)) || defined(IPK8) #if (!defined(AMG_HAVE_SLUDIST)) || defined(PSB_IPK8)
type, extends(amg_d_base_solver_type) :: amg_d_sludist_solver_type type, extends(amg_d_base_solver_type) :: amg_d_sludist_solver_type
@@ -259,7 +259,7 @@ contains
Implicit None Implicit None
! Arguments ! Arguments
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_sludist_solver_type), intent(inout) :: sv class(amg_d_sludist_solver_type), intent(inout) :: sv
integer, intent(out) :: info integer, intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -97,7 +97,7 @@ contains
character(len=*), intent(in), optional :: prefix character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_ character(1024) :: prefix_
info = psb_success_
if (present(prefix)) then if (present(prefix)) then
prefix_ = prefix prefix_ = prefix
else else
+64 -208
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -51,7 +51,7 @@ module amg_d_umf_solver
use iso_c_binding use iso_c_binding
use amg_d_base_solver_mod use amg_d_base_solver_mod
#if defined(IPK8) #if defined(PSB_IPK8)
type, extends(amg_d_base_solver_type) :: amg_d_umf_solver_type type, extends(amg_d_base_solver_type) :: amg_d_umf_solver_type
end type amg_d_umf_solver_type end type amg_d_umf_solver_type
@@ -62,9 +62,9 @@ module amg_d_umf_solver
type(c_ptr) :: symbolic=c_null_ptr, numeric=c_null_ptr type(c_ptr) :: symbolic=c_null_ptr, numeric=c_null_ptr
integer(c_long_long) :: symbsize=0, numsize=0 integer(c_long_long) :: symbsize=0, numsize=0
contains contains
procedure, pass(sv) :: build => d_umf_solver_bld procedure, pass(sv) :: build => amg_d_umf_solver_bld
procedure, pass(sv) :: apply_a => d_umf_solver_apply procedure, pass(sv) :: apply_a => amg_d_umf_solver_apply
procedure, pass(sv) :: apply_v => d_umf_solver_apply_vect procedure, pass(sv) :: apply_v => amg_d_umf_solver_apply_vect
procedure, pass(sv) :: free => d_umf_solver_free procedure, pass(sv) :: free => d_umf_solver_free
procedure, pass(sv) :: clear_data => d_umf_solver_clear_data procedure, pass(sv) :: clear_data => d_umf_solver_clear_data
procedure, pass(sv) :: descr => d_umf_solver_descr procedure, pass(sv) :: descr => d_umf_solver_descr
@@ -75,9 +75,8 @@ module amg_d_umf_solver
end type amg_d_umf_solver_type end type amg_d_umf_solver_type
private :: d_umf_solver_bld, d_umf_solver_apply, & private :: d_umf_solver_free, d_umf_solver_descr, &
& d_umf_solver_free, d_umf_solver_descr, & & d_umf_solver_sizeof, &
& d_umf_solver_sizeof, d_umf_solver_apply_vect, &
& d_umf_solver_get_fmt, d_umf_solver_get_id, & & d_umf_solver_get_fmt, d_umf_solver_get_id, &
& d_umf_solver_clear_data & d_umf_solver_clear_data
private :: d_umf_solver_finalize private :: d_umf_solver_finalize
@@ -118,208 +117,65 @@ module amg_d_umf_solver
end function amg_dumf_free end function amg_dumf_free
end interface end interface
interface
subroutine amg_d_umf_solver_apply(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
use psb_base_mod
import amg_d_umf_solver_type
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(amg_d_umf_solver_type), intent(inout) :: sv
real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
real(psb_dpk_),intent(inout), optional :: initu(:)
end subroutine amg_d_umf_solver_apply
end interface
interface
subroutine amg_d_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,wv,info,init,initu)
use psb_base_mod
import amg_d_umf_solver_type
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(amg_d_umf_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu
end subroutine amg_d_umf_solver_apply_vect
end interface
interface
subroutine amg_d_umf_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
use psb_base_mod
import amg_d_umf_solver_type
Implicit None
! Arguments
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_umf_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
end subroutine amg_d_umf_solver_bld
end interface
contains contains
subroutine d_umf_solver_apply(alpha,sv,x,beta,y,desc_data,&
& trans,work,info,init,initu)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(amg_d_umf_solver_type), intent(inout) :: sv
real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
character, intent(in), optional :: init
real(psb_dpk_),intent(inout), optional :: initu(:)
integer :: n_row,n_col
real(psb_dpk_), pointer :: ww(:)
integer(psb_ipk_) :: i, err_act
character :: trans_
character(len=20) :: name='d_umf_solver_apply'
call psb_erractionsave(err_act)
info = psb_success_
trans_ = psb_toupper(trans)
select case(trans_)
case('N')
case('T','C')
case default
call psb_errpush(psb_err_iarg_invalid_i_,name)
goto 9999
end select
!
! For non-iterative solvers, init and initu are ignored.
!
n_row = desc_data%get_local_rows()
n_col = desc_data%get_local_cols()
if (n_col <= size(work)) then
ww => work(1:n_col)
else
allocate(ww(n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/n_col,0,0,0,0/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
endif
select case(trans_)
case('N')
info = amg_dumf_solve(0,n_row,ww,x,n_row,sv%numeric)
case('T')
!
! Note: with UMF, 1 meand Ctranspose, 2 means transpose
! even for complex data.
!
if (psb_d_is_complex_) then
info = amg_dumf_solve(2,n_row,ww,x,n_row,sv%numeric)
else
info = amg_dumf_solve(1,n_row,ww,x,n_row,sv%numeric)
end if
case('C')
info = amg_dumf_solve(1,n_row,ww,x,n_row,sv%numeric)
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve')
goto 9999
end select
if (info == psb_success_) call psb_geaxpby(alpha,ww,beta,y,desc_data,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve')
goto 9999
endif
if (n_col > size(work)) then
deallocate(ww)
endif
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_umf_solver_apply
subroutine d_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
& trans,work,wv,info,init,initu)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(amg_d_umf_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
type(psb_d_vect_type),intent(inout) :: wv(:)
integer, intent(out) :: info
character, intent(in), optional :: init
type(psb_d_vect_type),intent(inout), optional :: initu
integer :: err_act
character(len=20) :: name='d_umf_solver_apply_vect'
call psb_erractionsave(err_act)
info = psb_success_
!
! For non-iterative solvers, init and initu are ignored.
!
call x%v%sync()
call y%v%sync()
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
call y%v%set_host()
if (info /= 0) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_umf_solver_apply_vect
subroutine d_umf_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
use psb_base_mod
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_umf_solver_type), intent(inout) :: sv
integer, intent(out) :: info
type(psb_dspmat_type), intent(in), target, optional :: b
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
! Local variables
type(psb_dspmat_type) :: atmp
type(psb_d_csc_sparse_mat) :: acsc
integer :: n_row,n_col, nrow_a, nztota
type(psb_ctxt_type) :: ctxt
integer :: np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_umf_solver_bld', ch_err
info=psb_success_
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' start'
n_row = desc_a%get_local_rows()
n_col = desc_a%get_local_cols()
call a%cscnv(atmp,info,type='coo')
call psb_rwextd(n_row,atmp,info,b=b)
call atmp%cscnv(info,type='csc',dupl=psb_dupl_add_)
call atmp%mv_to(acsc)
nrow_a = acsc%get_nrows()
nztota = acsc%get_nzeros()
! Fix the entres to call C-base UMFPACK.
acsc%ia(:) = acsc%ia(:) - 1
acsc%icp(:) = acsc%icp(:) - 1
info = amg_dumf_fact(nrow_a,nztota,acsc%val,&
& acsc%ia,acsc%icp,sv%symbolic,sv%numeric,&
& sv%symbsize,sv%numsize)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='amg_dumf_fact'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call acsc%free()
call atmp%free()
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' end'
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine d_umf_solver_bld
subroutine d_umf_solver_free(sv,info) subroutine d_umf_solver_free(sv,info)
+1 -1
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+1 -1
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+3 -6
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -62,9 +62,6 @@ module amg_s_ainv_solver
procedure, pass(sv) :: cseti => amg_s_ainv_solver_cseti procedure, pass(sv) :: cseti => amg_s_ainv_solver_cseti
procedure, pass(sv) :: csetc => amg_s_ainv_solver_csetc procedure, pass(sv) :: csetc => amg_s_ainv_solver_csetc
procedure, pass(sv) :: csetr => amg_s_ainv_solver_csetr procedure, pass(sv) :: csetr => amg_s_ainv_solver_csetr
!!$ procedure, pass(sv) :: seti => amg_s_ainv_solver_seti
!!$ procedure, pass(sv) :: setc => amg_s_ainv_solver_setc
!!$ procedure, pass(sv) :: setr => amg_s_ainv_solver_setr
procedure, pass(sv) :: descr => amg_s_ainv_solver_descr procedure, pass(sv) :: descr => amg_s_ainv_solver_descr
procedure, pass(sv) :: default => s_ainv_solver_default procedure, pass(sv) :: default => s_ainv_solver_default
procedure, nopass :: stringval => s_ainv_stringval procedure, nopass :: stringval => s_ainv_stringval
@@ -106,7 +103,7 @@ module amg_s_ainv_solver
Implicit None Implicit None
! Arguments ! Arguments
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_ainv_solver_type), intent(inout) :: sv class(amg_s_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -228,7 +225,7 @@ module amg_s_ainv_solver
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_d_vect_type, psb_s_base_vect_type, psb_spk_, psb_ipk_ & psb_d_vect_type, psb_s_base_vect_type, psb_spk_, psb_ipk_
implicit none implicit none
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
integer(psb_ipk_), intent(in) :: fillin,alg integer(psb_ipk_), intent(in) :: fillin,alg
real(psb_spk_), intent(in) :: thresh real(psb_spk_), intent(in) :: thresh
type(psb_sspmat_type), intent(inout) :: wmat, zmat type(psb_sspmat_type), intent(inout) :: wmat, zmat
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -230,7 +230,7 @@ module amg_s_as_smoother
& psb_desc_type, psb_s_base_sparse_mat, psb_ipk_,& & psb_desc_type, psb_s_base_sparse_mat, psb_ipk_,&
& psb_i_base_vect_type & psb_i_base_vect_type
implicit none implicit none
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_as_smoother_type), intent(inout) :: sm class(amg_s_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+8 -8
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -89,7 +89,7 @@ module amg_s_base_aggregator_mod
procedure, pass(ag) :: bld_tprol => amg_s_base_aggregator_build_tprol procedure, pass(ag) :: bld_tprol => amg_s_base_aggregator_build_tprol
procedure, pass(ag) :: mat_bld => amg_s_base_aggregator_mat_bld procedure, pass(ag) :: mat_bld => amg_s_base_aggregator_mat_bld
procedure, pass(ag) :: mat_asb => amg_s_base_aggregator_mat_asb procedure, pass(ag) :: mat_asb => amg_s_base_aggregator_mat_asb
procedure, pass(ag) :: bld_map => amg_s_base_aggregator_bld_map procedure, pass(ag) :: bld_linmap => amg_s_base_aggregator_bld_linmap
procedure, pass(ag) :: update_next => amg_s_base_aggregator_update_next procedure, pass(ag) :: update_next => amg_s_base_aggregator_update_next
procedure, pass(ag) :: clone => amg_s_base_aggregator_clone procedure, pass(ag) :: clone => amg_s_base_aggregator_clone
procedure, pass(ag) :: free => amg_s_base_aggregator_free procedure, pass(ag) :: free => amg_s_base_aggregator_free
@@ -302,7 +302,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! Do nothing ! Do nothing
info = psb_success_
return return
end subroutine amg_s_base_aggregator_set_aggr_type end subroutine amg_s_base_aggregator_set_aggr_type
@@ -458,7 +458,7 @@ contains
end subroutine amg_s_base_aggregator_mat_asb end subroutine amg_s_base_aggregator_mat_asb
! !
!> Function bld_map !> Function bld_linmap
!! \memberof amg_s_base_aggregator_type !! \memberof amg_s_base_aggregator_type
!! \brief Build linear map between hierarchy levels !! \brief Build linear map between hierarchy levels
!! !!
@@ -473,7 +473,7 @@ contains
!! \param map The output map !! \param map The output map
!! \param info Return code !! \param info Return code
!! !!
subroutine amg_s_base_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,& subroutine amg_s_base_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
& op_restr,op_prol,map,info) & op_restr,op_prol,map,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
@@ -484,8 +484,9 @@ contains
type(psb_slinmap_type), intent(out) :: map type(psb_slinmap_type), intent(out) :: map
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='s_base_aggregator_bld_map' character(len=20) :: name='s_base_aggregator_bld_linmap'
info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! !
! Copy the prolongation/restriction matrices into the descriptor map. ! Copy the prolongation/restriction matrices into the descriptor map.
@@ -507,7 +508,6 @@ contains
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine amg_s_base_aggregator_bld_map end subroutine amg_s_base_aggregator_bld_linmap
end module amg_s_base_aggregator_mod end module amg_s_base_aggregator_mod
+1 -1
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -237,7 +237,7 @@ module amg_s_base_smoother_mod
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_base_smoother_type, psb_ipk_, psb_i_base_vect_type & amg_s_base_smoother_type, psb_ipk_, psb_i_base_vect_type
! Arguments ! Arguments
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_base_smoother_type), intent(inout) :: sm class(amg_s_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -170,7 +170,7 @@ module amg_s_base_solver_mod
Implicit None Implicit None
! Arguments ! Arguments
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_base_solver_type), intent(inout) :: sv class(amg_s_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+3 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -150,7 +150,7 @@ contains
class(amg_s_dec_aggregator_type), intent(inout) :: ag class(amg_s_dec_aggregator_type), intent(inout) :: ag
type(amg_sml_parms), intent(in) :: parms type(amg_sml_parms), intent(in) :: parms
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_
select case(parms%aggr_type) select case(parms%aggr_type)
case (amg_noalg_) case (amg_noalg_)
ag%soc_map_bld => null() ag%soc_map_bld => null()
@@ -192,6 +192,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_ character(1024) :: prefix_
info = psb_success_
if (present(prefix)) then if (present(prefix)) then
prefix_ = prefix prefix_ = prefix
else else
+3 -3
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -119,7 +119,7 @@ module amg_s_diag_solver
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_diag_solver_type, psb_ipk_, psb_i_base_vect_type & amg_s_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_diag_solver_type), intent(inout) :: sv class(amg_s_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -331,7 +331,7 @@ module amg_s_l1_diag_solver
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type & amg_s_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_l1_diag_solver_type), intent(inout) :: sv class(amg_s_l1_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -181,7 +181,7 @@ module amg_s_gs_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,& & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_gs_solver_type), intent(inout) :: sv class(amg_s_gs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -195,7 +195,7 @@ module amg_s_gs_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,& & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_bwgs_solver_type), intent(inout) :: sv class(amg_s_bwgs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
-125
View File
@@ -1,125 +0,0 @@
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
!
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. 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.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific 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 THE AMG4PSBLAS GROUP OR ITS CONTRIBUTORS
! 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.
!
!
!
!
! The aggregator object hosts the aggregation method for building
! the multilevel hierarchy. This variant is based on the hybrid method
! presented in
!
! S. Gratton, P. Henon, P. Jiranek and X. Vasseur:
! Reducing complexity of algebraic multigrid by aggregation
! Numerical Lin. Algebra with Applications, 2016, 23:501-518
!
module amg_s_hybrid_aggregator_mod
use amg_s_dec_aggregator_mod
!
! sm - class(amg_T_base_smoother_type), allocatable
! The current level preconditioner (aka smoother).
! parms - type(amg_RTml_parms)
! The parameters defining the multilevel strategy.
! ac - The local part of the current-level matrix, built by
! coarsening the previous-level matrix.
! desc_ac - type(psb_desc_type).
! The communication descriptor associated to the matrix
! stored in ac.
! base_a - type(psb_Tspmat_type), pointer.
! Pointer (really a pointer!) to the local part of the current
! matrix (so we have a unified treatment of residuals).
! We need this to avoid passing explicitly the current matrix
! to the routine which applies the preconditioner.
! base_desc - type(psb_desc_type), pointer.
! Pointer to the communication descriptor associated to the
! matrix pointed by base_a.
! map - Stores the maps (restriction and prolongation) between the
! vector spaces associated to the index spaces of the previous
! and current levels.
!
! Methods:
! Most methods follow the encapsulation hierarchy: they take whatever action
! is appropriate for the current object, then call the corresponding method for
! the contained object.
! As an example: the descr() method prints out a description of the
! level. It starts by invoking the descr() method of the parms object,
! then calls the descr() method of the smoother object.
!
! descr - Prints a description of the object.
! default - Set default values
! dump - Dump to file object contents
! set - Sets various parameters; when a request is unknown
! it is passed to the smoother object for further processing.
! check - Sanity checks.
! sizeof - Total memory occupation in bytes
! get_nzeros - Number of nonzeros
!
!
type, extends(amg_s_dec_aggregator_type) :: amg_s_hybrid_aggregator_type
contains
procedure, pass(ag) :: bld_tprol => amg_s_hybrid_aggregator_build_tprol
procedure, nopass :: fmt => amg_s_hybrid_aggregator_fmt
end type amg_s_hybrid_aggregator_type
interface
subroutine amg_s_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
import :: amg_s_hybrid_aggregator_type, psb_desc_type, psb_sspmat_type, psb_spk_, &
& psb_ipk_, psb_long_int_k_, amg_sml_parms
implicit none
class(amg_s_hybrid_aggregator_type), target, intent(inout) :: ag
type(amg_sml_parms), intent(inout) :: parms
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
type(psb_sspmat_type), intent(out) :: op_prol
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_hybrid_aggregator_build_tprol
end interface
contains
function amg_s_hybrid_aggregator_fmt() result(val)
implicit none
character(len=32) :: val
val = "Hybrid Decoupled aggregation"
end function amg_s_hybrid_aggregator_fmt
end module amg_s_hybrid_aggregator_mod
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -123,7 +123,7 @@ contains
Implicit None Implicit None
! Arguments ! Arguments
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_id_solver_type), intent(inout) :: sv class(amg_s_id_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+1 -1
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -144,7 +144,7 @@ module amg_s_ilu_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,& & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_ilu_solver_type), intent(inout) :: sv class(amg_s_ilu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+4 -4
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -56,7 +56,7 @@ module amg_s_inner_mod
& psb_spk_, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_ & psb_spk_, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
import :: amg_sprec_type import :: amg_sprec_type
implicit none implicit none
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
type(amg_sprec_type), intent(inout), target :: prec type(amg_sprec_type), intent(inout), target :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -67,7 +67,7 @@ module amg_s_inner_mod
end interface amg_mlprec_bld end interface amg_mlprec_bld
interface amg_mlprec_aply interface amg_mlprec_aply
subroutine amg_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) subroutine amg_smlprec_aply_a(alpha,p,x,beta,y,desc_data,trans,work,info)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_ import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
import :: amg_sprec_type import :: amg_sprec_type
implicit none implicit none
@@ -79,7 +79,7 @@ module amg_s_inner_mod
character,intent(in) :: trans character,intent(in) :: trans
real(psb_spk_),target :: work(:) real(psb_spk_),target :: work(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine amg_smlprec_aply end subroutine amg_smlprec_aply_a
subroutine amg_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) subroutine amg_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
import :: psb_sspmat_type, psb_desc_type, & import :: psb_sspmat_type, psb_desc_type, &
& psb_spk_, psb_s_vect_type, psb_ipk_ & psb_spk_, psb_s_vect_type, psb_ipk_
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -94,7 +94,7 @@ module amg_s_invk_solver
Implicit None Implicit None
! Arguments ! Arguments
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_invk_solver_type), intent(inout) :: sv class(amg_s_invk_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -94,7 +94,7 @@ module amg_s_invt_solver
Implicit None Implicit None
! Arguments ! Arguments
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_invt_solver_type), intent(inout) :: sv class(amg_s_invt_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -151,7 +151,7 @@ module amg_s_jac_smoother
import :: psb_desc_type, amg_s_jac_smoother_type, psb_s_vect_type, psb_spk_, & import :: psb_desc_type, amg_s_jac_smoother_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,& & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_jac_smoother_type), intent(inout) :: sm class(amg_s_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -274,7 +274,7 @@ module amg_s_jac_smoother
import :: psb_desc_type, amg_s_l1_jac_smoother_type, psb_s_vect_type, & import :: psb_desc_type, amg_s_l1_jac_smoother_type, psb_s_vect_type, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,& & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_l1_jac_smoother_type), intent(inout) :: sm class(amg_s_l1_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -143,7 +143,7 @@ module amg_s_jac_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,& & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_jac_solver_type), intent(inout) :: sv class(amg_s_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -160,7 +160,7 @@ module amg_s_jac_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,& & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_l1_jac_solver_type), intent(inout) :: sv class(amg_s_l1_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -23,7 +23,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -57,7 +57,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -174,7 +174,7 @@ module amg_s_krm_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,& & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
implicit none implicit none
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_krm_solver_type), intent(inout) :: sv class(amg_s_krm_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -54,7 +54,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -73,6 +73,22 @@ module amg_s_matchboxp_mod
use iso_c_binding use iso_c_binding
use psb_base_cbind_mod use psb_base_cbind_mod
#if defined(PSB_SERIAL_MPI)
interface MatchingC
subroutine sMatchingC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate) bind(c,name='sMatching')
use iso_c_binding
import :: psb_c_ipk_, psb_c_lpk_
implicit none
integer(psb_c_lpk_), value :: nlver,nledge
integer(psb_c_lpk_) :: verlocptr(*),verlocind(*), verdistance(*)
integer(psb_c_lpk_) :: mate(*)
real(c_float) :: edgelocweight(*)
end subroutine sMatchingC
end interface MatchingC
#else
interface MatchBoxPC interface MatchBoxPC
subroutine sMatchBoxPC(nlver,nledge,verlocptr,verlocind,edgelocweight,& subroutine sMatchBoxPC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate, myrank, numprocs, icomm,& & verdistance, mate, myrank, numprocs, icomm,&
@@ -93,7 +109,7 @@ module amg_s_matchboxp_mod
real(c_double) :: msgpercent(*) real(c_double) :: msgpercent(*)
end subroutine sMatchBoxPC end subroutine sMatchBoxPC
end interface MatchBoxPC end interface MatchBoxPC
#endif
interface amg_i_aggr_assign interface amg_i_aggr_assign
module procedure amg_i_s_aggr_assign module procedure amg_i_s_aggr_assign
end interface amg_i_aggr_assign end interface amg_i_aggr_assign
@@ -145,7 +161,7 @@ contains
logical, parameter :: dump=.false., debug=.false., dump_mate=.false., & logical, parameter :: dump=.false., debug=.false., dump_mate=.false., &
& debug_ilaggr=.false., debug_sync=.false., debug_mate=.false. & debug_ilaggr=.false., debug_sync=.false., debug_mate=.false.
integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1 integer(psb_ipk_), save :: idx_bldmtc=-1, idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
logical, parameter :: do_timings=.true. logical, parameter :: do_timings=.false.
integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2 integer, parameter :: ilaggr_neginit=-1, ilaggr_nonlocal=-2
ictxt = desc_a%get_ctxt() ictxt = desc_a%get_ctxt()
@@ -608,7 +624,7 @@ contains
logical, parameter :: old_style=.false., sort_minp=.true. logical, parameter :: old_style=.false., sort_minp=.true.
character(len=40) :: name='build_matching', fname character(len=40) :: name='build_matching', fname
integer(psb_ipk_), save :: idx_cmboxp=-1, idx_bldahat=-1, idx_phase2=-1, idx_phase3=-1 integer(psb_ipk_), save :: idx_cmboxp=-1, idx_bldahat=-1, idx_phase2=-1, idx_phase3=-1
logical, parameter :: do_timings=.true. logical, parameter :: do_timings=.false.
ictxt = desc_a%get_ctxt() ictxt = desc_a%get_ctxt()
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@@ -810,7 +826,7 @@ contains
character(len=80) :: aname character(len=80) :: aname
real(psb_spk_), parameter :: eps=epsilon(1.d0) real(psb_spk_), parameter :: eps=epsilon(1.d0)
integer(psb_ipk_), save :: idx_glbt=-1, idx_phase1=-1, idx_phase2=-1 integer(psb_ipk_), save :: idx_glbt=-1, idx_phase1=-1, idx_phase2=-1
logical, parameter :: do_timings=.true. logical, parameter :: do_timings=.false.
logical, parameter :: debug_symmetry = .false., check_size=.false. logical, parameter :: debug_symmetry = .false., check_size=.false.
logical, parameter :: unroll_logtrans=.false. logical, parameter :: unroll_logtrans=.false.
@@ -863,7 +879,7 @@ contains
nr = tcoo1%get_nrows() nr = tcoo1%get_nrows()
nc = tcoo1%get_ncols() nc = tcoo1%get_ncols()
nz = tcoo1%get_nzeros() nz = tcoo1%get_nzeros()
call tcoo2%allocate(nr,nc,int(1.25*nz)) call tcoo2%allocate(nr,nc,int(1.25*nz,psb_ipk_))
k2 = 0 k2 = 0
! !
! Build the entries of \^A for matching ! Build the entries of \^A for matching
@@ -1040,7 +1056,8 @@ contains
integer(psb_c_lpk_) :: ph1_card(*),ph2_card(*) integer(psb_c_lpk_) :: ph1_card(*),ph2_card(*)
real(c_float) :: edgelocweight(:) real(c_float) :: edgelocweight(:)
real(c_double) :: msgpercent(*) real(c_double) :: msgpercent(*)
integer(psb_ipk_) :: info, me, np integer(psb_ipk_) :: info
integer(psb_mpk_) :: me, np
integer(psb_c_mpk_) :: icomm, mrank, mnp integer(psb_c_mpk_) :: icomm, mrank, mnp
logical, optional :: display_inp logical, optional :: display_inp
! !
@@ -1129,11 +1146,15 @@ contains
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (me == 0) write(0,*)' Calling MatchBoxP ' if (me == 0) write(0,*)' Calling MatchBoxP '
end if end if
#if defined(PSB_SERIAL_MPI)
call MatchingC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate)
#else
call MatchBoxPC(nlver,nledge,verlocptr,verlocind,edgelocweight,& call MatchBoxPC(nlver,nledge,verlocptr,verlocind,edgelocweight,&
& verdistance, mate, mrank, mnp, icomm,& & verdistance, mate, mrank, mnp, icomm,&
& msgindsent,msgactualsent,msgpercent,& & msgindsent,msgactualsent,msgpercent,&
& ph0_time, ph1_time, ph2_time, ph1_card, ph2_card) & ph0_time, ph1_time, ph2_time, ph1_card, ph2_card)
#endif
verlocptr(:) = verlocptr(:) + 1 verlocptr(:) = verlocptr(:) + 1
verlocind(:) = verlocind(:) + 1 verlocind(:) = verlocind(:) + 1
verdistance(:) = verdistance(:) + 1 verdistance(:) = verdistance(:) + 1
+13 -13
View File
@@ -21,7 +21,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -52,10 +52,10 @@
! !
module amg_s_mumps_solver module amg_s_mumps_solver
use amg_s_base_solver_mod use amg_s_base_solver_mod
#if defined(HAVE_MUMPS_) && defined(HAVE_MUMPS_MODULES_) #if defined(AMG_HAVE_MUMPS) && defined(AMG_HAVE_MUMPS_MODULES)
use smumps_struc_def use smumps_struc_def
#endif #endif
#if defined(HAVE_MUMPS_) && defined(HAVE_MUMPS_INCLUDES_) #if defined(AMG_HAVE_MUMPS) && defined(AMG_HAVE_MUMPS_INCLUDES)
include 'smumps_struc.h' include 'smumps_struc.h'
#endif #endif
@@ -68,7 +68,7 @@ module amg_s_mumps_solver
end type amg_s_mumps_rcntl_item end type amg_s_mumps_rcntl_item
type, extends(amg_s_base_solver_type) :: amg_s_mumps_solver_type type, extends(amg_s_base_solver_type) :: amg_s_mumps_solver_type
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
type(smumps_struc), allocatable :: id type(smumps_struc), allocatable :: id
#else #else
integer, allocatable :: id integer, allocatable :: id
@@ -163,7 +163,7 @@ module amg_s_mumps_solver
Implicit None Implicit None
! Arguments ! Arguments
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_mumps_solver_type), intent(inout) :: sv class(amg_s_mumps_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -189,7 +189,7 @@ contains
info = 0 info = 0
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@@ -239,7 +239,7 @@ contains
character(len=20) :: name='s_mumps_solver_clear_data' character(len=20) :: name='s_mumps_solver_clear_data'
info = 0 info = 0
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (allocated(sv%id)) then if (allocated(sv%id)) then
if (sv%built) then if (sv%built) then
@@ -279,7 +279,7 @@ contains
character(len=20) :: name='s_mumps_solver_free' character(len=20) :: name='s_mumps_solver_free'
info = 0 info = 0
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call sv%clear_data(info) call sv%clear_data(info)
if ((info == 0).and.allocated(sv%icntl)) deallocate(sv%icntl,stat=info) if ((info == 0).and.allocated(sv%icntl)) deallocate(sv%icntl,stat=info)
@@ -383,7 +383,7 @@ subroutine s_mumps_solver_csetc(sv,what,val,info,idx)
select case(psb_toupper(trim(what))) select case(psb_toupper(trim(what)))
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
case('MUMPS_LOC_GLOB') case('MUMPS_LOC_GLOB')
sv%ipar(1) = sv%stringval(psb_toupper(trim(val))) sv%ipar(1) = sv%stringval(psb_toupper(trim(val)))
#endif #endif
@@ -421,7 +421,7 @@ subroutine s_mumps_solver_cseti(sv,what,val,info,idx)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
select case(psb_toupper(what)) select case(psb_toupper(what))
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
case('MUMPS_LOC_GLOB') case('MUMPS_LOC_GLOB')
sv%ipar(1) = val sv%ipar(1) = val
case('MUMPS_PRINT_ERR') case('MUMPS_PRINT_ERR')
@@ -467,7 +467,7 @@ subroutine s_mumps_solver_csetr(sv,what,val,info,idx)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
select case(psb_toupper(what)) select case(psb_toupper(what))
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
case('MUMPS_RPAR_ENTRY') case('MUMPS_RPAR_ENTRY')
if(present(idx)) then if(present(idx)) then
! Note: this will allocate %item ! Note: this will allocate %item
@@ -504,7 +504,7 @@ subroutine s_mumps_solver_default(sv)
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
if (.not.allocated(sv%id)) then if (.not.allocated(sv%id)) then
allocate(sv%id,stat=info) allocate(sv%id,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
@@ -561,7 +561,7 @@ function s_mumps_solver_sizeof(sv) result(val)
class(amg_s_mumps_solver_type), intent(in) :: sv class(amg_s_mumps_solver_type), intent(in) :: sv
integer(psb_epk_) :: val integer(psb_epk_) :: val
integer :: i integer :: i
#if defined(HAVE_MUMPS_) #if defined(AMG_HAVE_MUMPS)
val = (sv%id%INFOG(22)+sv%id%INFOG(32))*1d+6 val = (sv%id%INFOG(22)+sv%id%INFOG(32))*1d+6
#else #else
val = 0 val = 0
+161 -376
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -155,13 +155,35 @@ module amg_s_onelev_mod
private :: s_wrk_alloc, s_wrk_free, & private :: s_wrk_alloc, s_wrk_free, &
& s_wrk_clone, s_wrk_move_alloc, s_wrk_cnv, s_wrk_sizeof & s_wrk_clone, s_wrk_move_alloc, s_wrk_cnv, s_wrk_sizeof
!
! Remap.
! This keeps track of remapping.
! Logic here is as follows:
! 1. AC_PRE_REMAP need to figure out if we
! really need it.
! 2. DESC_AC_PRE_REMAP contains the descriptor before
! remapping. Meaning that it is possible
! to implement the RESTRICTOR operator by
! a. Doing LINMAP_U2V onto this one
! b. For each process, send the data to
! IDEST.
! This assumes that remapping goes by
! a factor of 2.
! For the PROLONGATOR operators, we first
! use DESC_AC, then split and send onto
! the processes in DESC_AC_PRE_REMAP.
!
! To be fixed: what happens if NP the starting processes
! is not an even number? Coordinate with _X_remap in PSBLAS
!
type amg_s_remap_data_type type amg_s_remap_data_type
type(psb_sspmat_type) :: ac_pre_remap type(psb_sspmat_type) :: ac_pre_remap
type(psb_desc_type) :: desc_ac_pre_remap type(psb_desc_type) :: desc_ac_pre_remap
integer(psb_ipk_) :: idest integer(psb_ipk_) :: idest
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:) integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
contains contains
procedure, pass(rmp) :: clone => s_remap_data_clone procedure, pass(rmp) :: clone => s_remap_data_clone
procedure, pass(rmp) :: move_alloc => s_remap_move_alloc
end type amg_s_remap_data_type end type amg_s_remap_data_type
type amg_s_onelev_type type amg_s_onelev_type
@@ -207,7 +229,7 @@ module amg_s_onelev_mod
procedure, pass(lv) :: get_wrksz => s_base_onelev_get_wrksize procedure, pass(lv) :: get_wrksz => s_base_onelev_get_wrksize
procedure, pass(lv) :: allocate_wrk => s_base_onelev_allocate_wrk procedure, pass(lv) :: allocate_wrk => s_base_onelev_allocate_wrk
procedure, pass(lv) :: free_wrk => s_base_onelev_free_wrk procedure, pass(lv) :: free_wrk => s_base_onelev_free_wrk
procedure, nopass :: stringval => amg_stringval procedure, nopass :: stringval => amg_stringval
procedure, pass(lv) :: move_alloc => s_base_onelev_move_alloc procedure, pass(lv) :: move_alloc => s_base_onelev_move_alloc
@@ -231,9 +253,7 @@ module amg_s_onelev_mod
& s_base_onelev_free_wrk & s_base_onelev_free_wrk
interface interface
subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info) module subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lsspmat_type, psb_lpk_
import :: amg_s_onelev_type
implicit none implicit none
class(amg_s_onelev_type), intent(inout), target :: lv class(amg_s_onelev_type), intent(inout), target :: lv
type(psb_sspmat_type), intent(in) :: a type(psb_sspmat_type), intent(in) :: a
@@ -245,10 +265,7 @@ module amg_s_onelev_mod
end interface end interface
interface interface
subroutine amg_s_base_onelev_build(lv,info,amold,vmold,imold,ilv) module subroutine amg_s_base_onelev_build(lv,info,amold,vmold,imold,ilv)
import :: psb_s_base_sparse_mat, psb_s_base_vect_type, &
& psb_i_base_vect_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv class(amg_s_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -260,10 +277,7 @@ module amg_s_onelev_mod
end interface end interface
interface interface
subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix) module subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments ! Arguments
class(amg_s_onelev_type), intent(in) :: lv class(amg_s_onelev_type), intent(in) :: lv
@@ -276,10 +290,8 @@ module amg_s_onelev_mod
end interface end interface
interface interface
subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global) module subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,&
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & & iout,verbosity, prefix,global)
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments ! Arguments
class(amg_s_onelev_type), intent(in) :: lv class(amg_s_onelev_type), intent(in) :: lv
@@ -293,10 +305,7 @@ module amg_s_onelev_mod
end interface end interface
interface interface
subroutine amg_s_base_onelev_cnv(lv,info,amold,vmold,imold) module subroutine amg_s_base_onelev_cnv(lv,info,amold,vmold,imold)
import :: amg_s_onelev_type, psb_s_base_vect_type, psb_spk_, &
& psb_s_base_sparse_mat, psb_ipk_, psb_i_base_vect_type
! Arguments
class(amg_s_onelev_type), intent(inout) :: lv class(amg_s_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_sparse_mat), intent(in), optional :: amold
@@ -306,48 +315,32 @@ module amg_s_onelev_mod
end interface end interface
interface interface
subroutine amg_s_base_onelev_free(lv,info) module subroutine amg_s_base_onelev_free(lv,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none implicit none
class(amg_s_onelev_type), intent(inout) :: lv class(amg_s_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_base_onelev_free end subroutine amg_s_base_onelev_free
end interface end interface
interface interface
subroutine amg_s_base_onelev_free_smoothers(lv,info) module subroutine amg_s_base_onelev_free_smoothers(lv,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none implicit none
class(amg_s_onelev_type), intent(inout) :: lv class(amg_s_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_base_onelev_free_smoothers end subroutine amg_s_base_onelev_free_smoothers
end interface end interface
interface interface
subroutine amg_s_base_onelev_check(lv,info) module subroutine amg_s_base_onelev_check(lv,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_s_onelev_type), intent(inout) :: lv class(amg_s_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_base_onelev_check end subroutine amg_s_base_onelev_check
end interface end interface
interface interface
subroutine amg_s_base_onelev_setsm(lv,val,info,pos) module subroutine amg_s_base_onelev_setsm(lv,val,info,pos)
import :: psb_spk_, amg_s_onelev_type, amg_s_base_smoother_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_s_onelev_type), target, intent(inout) :: lv class(amg_s_onelev_type), target, intent(inout) :: lv
class(amg_s_base_smoother_type), intent(in) :: val class(amg_s_base_smoother_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -356,12 +349,8 @@ module amg_s_onelev_mod
end interface end interface
interface interface
subroutine amg_s_base_onelev_setsv(lv,val,info,pos) module subroutine amg_s_base_onelev_setsv(lv,val,info,pos)
import :: psb_spk_, amg_s_onelev_type, amg_s_base_solver_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_s_onelev_type), target, intent(inout) :: lv class(amg_s_onelev_type), target, intent(inout) :: lv
class(amg_s_base_solver_type), intent(in) :: val class(amg_s_base_solver_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -370,12 +359,8 @@ module amg_s_onelev_mod
end interface end interface
interface interface
subroutine amg_s_base_onelev_setag(lv,val,info,pos) module subroutine amg_s_base_onelev_setag(lv,val,info,pos)
import :: psb_spk_, amg_s_onelev_type, amg_s_base_aggregator_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_s_onelev_type), target, intent(inout) :: lv class(amg_s_onelev_type), target, intent(inout) :: lv
class(amg_s_base_aggregator_type), intent(in) :: val class(amg_s_base_aggregator_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@@ -384,13 +369,8 @@ module amg_s_onelev_mod
end interface end interface
interface interface
subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx) module subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_s_onelev_type), intent(inout) :: lv class(amg_s_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(in) :: val
@@ -401,12 +381,8 @@ module amg_s_onelev_mod
end interface end interface
interface interface
subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx) module subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
! Arguments
class(amg_s_onelev_type), intent(inout) :: lv class(amg_s_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what character(len=*), intent(in) :: what
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
@@ -417,12 +393,8 @@ module amg_s_onelev_mod
end interface end interface
interface interface
subroutine amg_s_base_onelev_csetr(lv,what,val,info,pos,idx) module subroutine amg_s_base_onelev_csetr(lv,what,val,info,pos,idx)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
Implicit None Implicit None
class(amg_s_onelev_type), intent(inout) :: lv class(amg_s_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val real(psb_spk_), intent(in) :: val
@@ -433,11 +405,8 @@ module amg_s_onelev_mod
end interface end interface
interface interface
subroutine amg_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,& module subroutine amg_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
& solver,tprol,global_num) & solver,tprol,global_num)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none implicit none
class(amg_s_onelev_type), intent(in) :: lv class(amg_s_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(in) :: level
@@ -448,8 +417,7 @@ module amg_s_onelev_mod
end interface end interface
interface interface
subroutine amg_s_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work) module subroutine amg_s_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
import
implicit none implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv class(amg_s_onelev_type), target, intent(inout) :: lv
real(psb_spk_), intent(in) :: alpha, beta real(psb_spk_), intent(in) :: alpha, beta
@@ -458,8 +426,8 @@ module amg_s_onelev_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_spk_), optional :: work(:) real(psb_spk_), optional :: work(:)
end subroutine amg_s_base_onelev_map_rstr_a end subroutine amg_s_base_onelev_map_rstr_a
subroutine amg_s_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty) module subroutine amg_s_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
import & work,vtx,vty)
implicit none implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv class(amg_s_onelev_type), target, intent(inout) :: lv
real(psb_spk_), intent(in) :: alpha, beta real(psb_spk_), intent(in) :: alpha, beta
@@ -471,8 +439,7 @@ module amg_s_onelev_mod
end interface end interface
interface interface
subroutine amg_s_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work) module subroutine amg_s_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
import
implicit none implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv class(amg_s_onelev_type), target, intent(inout) :: lv
real(psb_spk_), intent(in) :: alpha, beta real(psb_spk_), intent(in) :: alpha, beta
@@ -482,8 +449,8 @@ module amg_s_onelev_mod
real(psb_spk_), optional :: work(:) real(psb_spk_), optional :: work(:)
end subroutine amg_s_base_onelev_map_prol_a end subroutine amg_s_base_onelev_map_prol_a
subroutine amg_s_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty) module subroutine amg_s_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,&
import & work,vtx,vty)
implicit none implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv class(amg_s_onelev_type), target, intent(inout) :: lv
real(psb_spk_), intent(in) :: alpha, beta real(psb_spk_), intent(in) :: alpha, beta
@@ -494,6 +461,118 @@ module amg_s_onelev_mod
end subroutine amg_s_base_onelev_map_prol_v end subroutine amg_s_base_onelev_map_prol_v
end interface end interface
interface
module subroutine s_base_onelev_move_alloc(lv, b,info)
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv, b
integer(psb_ipk_), intent(out) :: info
end subroutine s_base_onelev_move_alloc
end interface
interface
module subroutine s_base_onelev_allocate_wrk(lv,info,vmold)
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: vmold
end subroutine s_base_onelev_allocate_wrk
end interface
interface
module subroutine s_base_onelev_free_wrk(lv,info)
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine s_base_onelev_free_wrk
end interface
interface
module subroutine s_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
Implicit None
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: vmold
type(psb_desc_type), intent(in), optional :: desc2
end subroutine s_wrk_alloc
end interface
interface
module subroutine s_inner_do_wrk_alloc(wk,nwv,desc,vmold)
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
class(psb_s_base_vect_type), intent(in), optional :: vmold
end subroutine s_inner_do_wrk_alloc
end interface
interface
module subroutine s_wrk_free(wk,info)
Implicit None
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
end subroutine s_wrk_free
end interface
interface
module subroutine s_wrk_clone(wk,wkout,info)
Implicit None
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
class(amg_smlprec_wrk_type), target, intent(inout) :: wkout
integer(psb_ipk_), intent(out) :: info
end subroutine s_wrk_clone
end interface
interface
module subroutine s_wrk_move_alloc(wk, b,info)
implicit none
class(amg_smlprec_wrk_type), target, intent(inout) :: wk, b
integer(psb_ipk_), intent(out) :: info
end subroutine s_wrk_move_alloc
end interface
interface
module subroutine s_wrk_cnv(wk,info,vmold)
Implicit None
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: vmold
end subroutine s_wrk_cnv
end interface
interface
module function s_wrk_sizeof(wk) result(val)
implicit none
class(amg_smlprec_wrk_type), intent(in) :: wk
integer(psb_epk_) :: val
end function s_wrk_sizeof
end interface
interface
module subroutine s_remap_data_clone(rmp, remap_out, info)
implicit none
! Arguments
class(amg_s_remap_data_type), target, intent(inout) :: rmp
class(amg_s_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
end subroutine s_remap_data_clone
end interface
interface
module subroutine s_remap_move_alloc(rmp, remap_out, info)
implicit none
! Arguments
class(amg_s_remap_data_type), target, intent(inout) :: rmp
class(amg_s_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
end subroutine s_remap_move_alloc
end interface
contains contains
! !
! Function returning the size of the amg_prec_type data structure ! Function returning the size of the amg_prec_type data structure
@@ -619,7 +698,7 @@ contains
! Arguments ! Arguments
class(amg_s_onelev_type), target, intent(inout) :: lv class(amg_s_onelev_type), target, intent(inout) :: lv
class(amg_s_onelev_type), target, intent(inout) :: lvout class(amg_s_onelev_type), target, intent(inout) :: lvout
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_ info = psb_success_
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
@@ -661,36 +740,6 @@ contains
end subroutine s_base_onelev_clone end subroutine s_base_onelev_clone
subroutine s_base_onelev_move_alloc(lv, b,info)
use psb_base_mod
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv, b
integer(psb_ipk_), intent(out) :: info
call b%free(info)
b%parms = lv%parms
b%szratio = lv%szratio
if (associated(lv%sm2,lv%sm2a)) then
call move_alloc(lv%sm,b%sm)
call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm2a
else
call move_alloc(lv%sm,b%sm)
call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm
end if
call move_alloc(lv%aggr,b%aggr)
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
b%base_a => lv%base_a
b%base_desc => lv%base_desc
end subroutine s_base_onelev_move_alloc
function s_base_onelev_get_wrksize(lv) result(val) function s_base_onelev_get_wrksize(lv) result(val)
implicit none implicit none
class(amg_s_onelev_type), intent(inout) :: lv class(amg_s_onelev_type), intent(inout) :: lv
@@ -728,269 +777,5 @@ contains
end function s_base_onelev_get_wrksize end function s_base_onelev_get_wrksize
subroutine s_base_onelev_allocate_wrk(lv,info,vmold)
use psb_base_mod
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: nwv, i
info = psb_success_
nwv = lv%get_wrksz()
if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
if (info == 0) then
if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
!
! Need to fix this, we need two different allocations
!
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold,&
& desc2=lv%remap_data%desc_ac_pre_remap)
else
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
end if
end if
end subroutine s_base_onelev_allocate_wrk
subroutine s_base_onelev_free_wrk(lv,info)
use psb_base_mod
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: nwv,i
info = psb_success_
if (allocated(lv%wrk)) then
call lv%wrk%free(info)
if (info == 0) deallocate(lv%wrk,stat=info)
end if
end subroutine s_base_onelev_free_wrk
subroutine s_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
use psb_base_mod
Implicit None
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: vmold
type(psb_desc_type), intent(in), optional :: desc2
!
integer(psb_ipk_) :: i
info = psb_success_
call wk%free(info)
if (present(desc2)) then
!!$ write(0,*) 'Check on wrk_alloc 2',&
!!$ & desc2%get_local_rows(), desc%get_local_rows(),&
!!$ & desc2%get_local_cols(),desc%get_local_cols()
!!$ flush(0)
if (desc2%get_local_cols()>desc%get_local_cols()) then
call psb_geasb(wk%vx2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc2,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc2,info,&
& scratch=.true.,mold=vmold)
end do
else
!!$ write(0,*) 'Check on wrk_alloc 1.5 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
else
!!$ write(0,*) 'Check on wrk_alloc 1 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
end subroutine s_wrk_alloc
subroutine s_wrk_free(wk,info)
Implicit None
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
if (allocated(wk%tx)) deallocate(wk%tx, stat=info)
if (allocated(wk%ty)) deallocate(wk%ty, stat=info)
if (allocated(wk%x2l)) deallocate(wk%x2l, stat=info)
if (allocated(wk%y2l)) deallocate(wk%y2l, stat=info)
call wk%vtx%free(info)
call wk%vty%free(info)
call wk%vx2l%free(info)
call wk%vy2l%free(info)
if (allocated(wk%wv)) then
do i=1,size(wk%wv)
call wk%wv(i)%free(info)
end do
deallocate(wk%wv, stat=info)
end if
end subroutine s_wrk_free
subroutine s_wrk_clone(wk,wkout,info)
use psb_base_mod
Implicit None
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
class(amg_smlprec_wrk_type), target, intent(inout) :: wkout
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call psb_safe_ab_cpy(wk%tx,wkout%tx,info)
call psb_safe_ab_cpy(wk%ty,wkout%ty,info)
call psb_safe_ab_cpy(wk%x2l,wkout%x2l,info)
call psb_safe_ab_cpy(wk%y2l,wkout%y2l,info)
call wk%vtx%clone(wkout%vtx,info)
call wk%vty%clone(wkout%vty,info)
call wk%vx2l%clone(wkout%vx2l,info)
call wk%vy2l%clone(wkout%vy2l,info)
if (allocated(wkout%wv)) then
do i=1,size(wkout%wv)
call wkout%wv(i)%free(info)
end do
deallocate( wkout%wv)
end if
allocate(wkout%wv(size(wk%wv)),stat=info)
do i=1,size(wk%wv)
call wk%wv(i)%clone(wkout%wv(i),info)
end do
return
end subroutine s_wrk_clone
subroutine s_wrk_move_alloc(wk, b,info)
implicit none
class(amg_smlprec_wrk_type), target, intent(inout) :: wk, b
integer(psb_ipk_), intent(out) :: info
call b%free(info)
call move_alloc(wk%tx,b%tx)
call move_alloc(wk%ty,b%ty)
call move_alloc(wk%x2l,b%x2l)
call move_alloc(wk%y2l,b%y2l)
!
! Should define V%move_alloc....
call move_alloc(wk%vtx%v,b%vtx%v)
call move_alloc(wk%vty%v,b%vty%v)
call move_alloc(wk%vx2l%v,b%vx2l%v)
call move_alloc(wk%vy2l%v,b%vy2l%v)
call move_alloc(wk%wv,b%wv)
end subroutine s_wrk_move_alloc
subroutine s_wrk_cnv(wk,info,vmold)
use psb_base_mod
Implicit None
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: i
info = psb_success_
if (present(vmold)) then
call wk%vtx%cnv(vmold)
call wk%vty%cnv(vmold)
call wk%vx2l%cnv(vmold)
call wk%vy2l%cnv(vmold)
if (allocated(wk%wv)) then
do i=1,size(wk%wv)
call wk%wv(i)%cnv(vmold)
end do
end if
end if
end subroutine s_wrk_cnv
function s_wrk_sizeof(wk) result(val)
use psb_realloc_mod
implicit none
class(amg_smlprec_wrk_type), intent(in) :: wk
integer(psb_epk_) :: val
integer :: i
val = 0
val = val + (1_psb_epk_ * psb_sizeof_sp) * psb_size(wk%tx)
val = val + (1_psb_epk_ * psb_sizeof_sp) * psb_size(wk%ty)
val = val + (1_psb_epk_ * psb_sizeof_sp) * psb_size(wk%x2l)
val = val + (1_psb_epk_ * psb_sizeof_sp) * psb_size(wk%y2l)
val = val + wk%vtx%sizeof()
val = val + wk%vty%sizeof()
val = val + wk%vx2l%sizeof()
val = val + wk%vy2l%sizeof()
if (allocated(wk%wv)) then
do i=1, size(wk%wv)
val = val + wk%wv(i)%sizeof()
end do
end if
end function s_wrk_sizeof
subroutine s_remap_data_clone(rmp, remap_out, info)
use psb_base_mod
implicit none
! Arguments
class(amg_s_remap_data_type), target, intent(inout) :: rmp
class(amg_s_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
if (info == psb_success_) &
& call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
remap_out%idest = rmp%idest
call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
end subroutine s_remap_data_clone
end module amg_s_onelev_mod end module amg_s_onelev_mod
+11 -18
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -54,7 +54,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -119,10 +119,6 @@
module amg_s_parmatch_aggregator_mod module amg_s_parmatch_aggregator_mod
use amg_s_base_aggregator_mod use amg_s_base_aggregator_mod
use amg_s_matchboxp_mod use amg_s_matchboxp_mod
#if defined(SERIAL_MPI)
type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type
end type amg_s_parmatch_aggregator_type
#else
type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type
integer(psb_ipk_) :: matching_alg integer(psb_ipk_) :: matching_alg
integer(psb_ipk_) :: n_sweeps ! When n_sweeps >1 we need an auxiliary descriptor integer(psb_ipk_) :: n_sweeps ! When n_sweeps >1 we need an auxiliary descriptor
@@ -140,7 +136,7 @@ module amg_s_parmatch_aggregator_mod
procedure, pass(ag) :: mat_bld => amg_s_parmatch_aggregator_mat_bld procedure, pass(ag) :: mat_bld => amg_s_parmatch_aggregator_mat_bld
procedure, pass(ag) :: mat_asb => amg_s_parmatch_aggregator_mat_asb procedure, pass(ag) :: mat_asb => amg_s_parmatch_aggregator_mat_asb
procedure, pass(ag) :: inner_mat_asb => amg_s_parmatch_aggregator_inner_mat_asb procedure, pass(ag) :: inner_mat_asb => amg_s_parmatch_aggregator_inner_mat_asb
procedure, pass(ag) :: bld_map => amg_s_parmatch_aggregator_bld_map procedure, pass(ag) :: bld_linmap => amg_s_parmatch_aggregator_bld_linmap
procedure, pass(ag) :: csetc => amg_s_parmatch_aggr_csetc procedure, pass(ag) :: csetc => amg_s_parmatch_aggr_csetc
procedure, pass(ag) :: cseti => amg_s_parmatch_aggr_cseti procedure, pass(ag) :: cseti => amg_s_parmatch_aggr_cseti
procedure, pass(ag) :: default => amg_s_parmatch_aggr_set_default procedure, pass(ag) :: default => amg_s_parmatch_aggr_set_default
@@ -400,6 +396,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix character(len=*), intent(in), optional :: prefix
character(1024) :: prefix_ character(1024) :: prefix_
info = psb_success_
if (present(prefix)) then if (present(prefix)) then
prefix_ = prefix prefix_ = prefix
else else
@@ -451,6 +448,7 @@ contains
class(amg_s_base_aggregator_type), target, intent(inout) :: agnext class(amg_s_base_aggregator_type), target, intent(inout) :: agnext
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = psb_success_
! !
! !
select type(agnext) select type(agnext)
@@ -590,7 +588,7 @@ contains
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = 0 info = psb_success_
if ((info == 0).and.allocated(ag%w)) deallocate(ag%w,stat=info) if ((info == 0).and.allocated(ag%w)) deallocate(ag%w,stat=info)
if ((info == 0).and.allocated(ag%w_nxt)) deallocate(ag%w_nxt,stat=info) if ((info == 0).and.allocated(ag%w_nxt)) deallocate(ag%w_nxt,stat=info)
if ((info == 0).and.allocated(ag%prol)) then if ((info == 0).and.allocated(ag%prol)) then
@@ -629,7 +627,7 @@ contains
class(amg_s_base_aggregator_type), allocatable, intent(inout) :: agnext class(amg_s_base_aggregator_type), allocatable, intent(inout) :: agnext
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = 0 info = psb_success_
if (allocated(agnext)) then if (allocated(agnext)) then
call agnext%free(info) call agnext%free(info)
if (info == 0) deallocate(agnext,stat=info) if (info == 0) deallocate(agnext,stat=info)
@@ -645,7 +643,7 @@ contains
end select end select
end subroutine amg_s_parmatch_aggregator_clone end subroutine amg_s_parmatch_aggregator_clone
subroutine amg_s_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,& subroutine amg_s_parmatch_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
& op_restr,op_prol,map,info) & op_restr,op_prol,map,info)
use psb_base_mod use psb_base_mod
implicit none implicit none
@@ -656,8 +654,9 @@ contains
type(psb_slinmap_type), intent(out) :: map type(psb_slinmap_type), intent(out) :: map
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='s_parmatch_aggregator_bld_map' character(len=20) :: name='s_parmatch_aggregator_bld_linmap'
info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! !
! Copy the prolongation/restriction matrices into the descriptor map. ! Copy the prolongation/restriction matrices into the descriptor map.
@@ -675,17 +674,11 @@ contains
map = psb_linmap(psb_map_gen_linear_,desc_a,& map = psb_linmap(psb_map_gen_linear_,desc_a,&
& desc_ac,op_restr,op_prol,ilaggr,nlaggr) & desc_ac,op_restr,op_prol,ilaggr,nlaggr)
end if end if
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
goto 9999
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine amg_s_parmatch_aggregator_bld_map end subroutine amg_s_parmatch_aggregator_bld_linmap
#endif
end module amg_s_parmatch_aggregator_mod end module amg_s_parmatch_aggregator_mod
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution. ! documentation and/or other materials provided with the distribution.
! 3. The name of the AMG4PSBLAS group or the names of its contributors may ! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this ! not be used to endorse or promote products derived from this
! software without specific written permission. ! software without specific prior written permission.
! !
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED ! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -140,7 +140,7 @@ module amg_s_poly_smoother
import :: psb_desc_type, amg_s_poly_smoother_type, psb_s_vect_type, psb_spk_, & import :: psb_desc_type, amg_s_poly_smoother_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,& & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type & psb_ipk_, psb_i_base_vect_type
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_poly_smoother_type), intent(inout) :: sm class(amg_s_poly_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info

Some files were not shown because too many files have changed in this diff Show More