mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-07 07:04:59 +00:00
Compare commits
469
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
2e79105695 | ||
|
|
921535c3c9 | ||
|
|
557809755e | ||
|
|
64105a17c5 | ||
|
|
67c32da222 | ||
|
|
f317a571f4 | ||
|
|
b075182ce6 | ||
|
|
be469f8844 | ||
|
|
04bcf04a9c | ||
|
|
725e39586d | ||
|
|
e68304e84f | ||
|
|
3972f27eb5 | ||
|
|
b21e5aebab | ||
|
|
6e2d61b51e | ||
|
|
4ee170f0ec | ||
|
|
4a9f8e9da0 | ||
|
|
94caab8aa9 | ||
|
|
749ab2f6ae | ||
|
|
bf96dd554c | ||
|
|
1aef82023c | ||
|
|
161b93da64 | ||
|
|
8d4af1ba9f | ||
|
|
cd87bdb0c1 | ||
|
|
53afa87814 | ||
|
|
13c99a0c3f | ||
|
|
1aa7c8db59 | ||
|
|
36b57eec24 | ||
|
|
417f8beaf9 | ||
|
|
d66bf1e2f8 | ||
|
|
c590a4088a | ||
|
|
80dfd1ad3b | ||
|
|
857844474a | ||
|
|
a85997926c | ||
|
|
70fb39ae55 | ||
|
|
82de529c54 | ||
|
|
db9757a45e | ||
|
|
5b654cc221 | ||
|
|
d518f5eac7 | ||
|
|
053d5c4bc0 | ||
|
|
032543d625 | ||
|
|
07149a02ad | ||
|
|
08a0c744b1 | ||
|
|
60324084d8 | ||
|
|
83ba79d7ae | ||
|
|
b704d50df1 | ||
|
|
68a9cceaa0 | ||
|
|
aec5a52c7f | ||
|
|
b5f5d356fd | ||
|
|
8966ecb4a6 | ||
|
|
3e9a5c0c5b | ||
|
|
dfc261cf34 | ||
|
|
cab98295e2 | ||
|
|
5a83c63810 | ||
|
|
2e43f55455 | ||
|
|
244fcda207 | ||
|
|
ca6fce0765 | ||
|
|
b6f92354d3 | ||
|
|
1b7fe6a9a7 | ||
|
|
14ea4d9c15 | ||
|
|
3ee333baac | ||
|
|
ecb41dfbbf | ||
|
|
33ac3f786b | ||
|
|
474c6a3634 | ||
|
|
c1e8bc0c57 | ||
|
|
2f5072166d | ||
|
|
89e2d53e8b | ||
|
|
bfe0a32e09 | ||
|
|
e88d176fed | ||
|
|
c96727a97c | ||
|
|
6362db0cc5 | ||
|
|
9239b16175 | ||
|
|
96a700cb9d | ||
|
|
41d91120d4 | ||
|
|
5d20407b15 | ||
|
|
322e3f65d1 | ||
|
|
3ff1ad9372 | ||
|
|
818ead5878 | ||
|
|
803d311d1c | ||
|
|
677e4fe6bc | ||
|
|
02a83575a2 | ||
|
|
cfbec1f6ea | ||
|
|
e11a134a1f | ||
|
|
6d05120930 | ||
|
|
bd2d1e3b26 | ||
|
|
c9605d1b29 | ||
|
|
67594f8b07 | ||
|
|
301fb57bb1 | ||
|
|
13eee99ea3 | ||
|
|
fb802c62cd | ||
|
|
767b606bb2 | ||
|
|
8492c07521 | ||
|
|
17698c2725 | ||
|
|
897c5229a6 | ||
|
|
ab5eaac5ed | ||
|
|
234071869d | ||
|
|
3e3b343131 | ||
|
|
5790aa0cbd | ||
|
|
a17f503486 | ||
|
|
74dccb6c44 | ||
|
|
e83bde6896 | ||
|
|
83d435b49e | ||
|
|
af3fda9690 | ||
|
|
678237cf29 | ||
|
|
3671285c7a | ||
|
|
a747cc6abb | ||
|
|
d385d99e71 | ||
|
|
4e6e3d5f09 | ||
|
|
7c48b96936 | ||
|
|
12478a2fff | ||
|
|
2ef4459b18 | ||
|
|
ea8974f88c | ||
|
|
54d608d2dd | ||
|
|
47bafd7fe7 | ||
|
|
c2fd0ac66d | ||
|
|
5387e206b1 | ||
|
|
ccef858192 | ||
|
|
30a5c7be03 | ||
|
|
737ebb9a96 | ||
|
|
dc15b931a0 | ||
|
|
23aabd794d | ||
|
|
a67454ef5c | ||
|
|
79317cb392 | ||
|
|
847ed6ae60 | ||
|
|
6ad82037c5 | ||
|
|
bee9d63e9c | ||
|
|
bb262275a1 | ||
|
|
14cd4cde76 | ||
|
|
ec9fcb1bcc | ||
|
|
2dd1cbd3dc | ||
|
|
fc34385341 | ||
|
|
5fbdfb1436 | ||
|
|
ea2f75776c | ||
|
|
1dcb542e4a | ||
|
|
84ea60c94c | ||
|
|
e8b50152fa | ||
|
|
e6894501dd | ||
|
|
975fc6265f | ||
|
|
a97f56d673 | ||
|
|
b1f05482a6 | ||
|
|
fb490cee7e | ||
|
|
24c85c7114 | ||
|
|
53998a1da9 | ||
|
|
0bcc9d7b55 | ||
|
|
11421f53a2 | ||
|
|
d33bcfe107 | ||
|
|
5bcd36f394 | ||
|
|
73495edf09 | ||
|
|
9e82d2e311 | ||
|
|
c1ecb4ebec | ||
|
|
e78449d0f5 | ||
|
|
e3de565b6d | ||
|
|
7b9c722a1a | ||
|
|
2fd718be6f | ||
|
|
3a5e73e4c8 | ||
|
|
494b8b925f | ||
|
|
73e5d49913 | ||
|
|
dd7cb86775 | ||
|
|
e1789b35bb | ||
|
|
a612cea167 | ||
|
|
ebe9b45177 | ||
|
|
32994c7ce8 | ||
|
|
426215044a | ||
|
|
eee0cdb577 | ||
|
|
92e0fd7f19 | ||
|
|
bccde3a8b0 | ||
|
|
e6d7f48fdf | ||
|
|
d59c9e6c0a | ||
|
|
0d624df346 | ||
|
|
8c84ba2464 | ||
|
|
28634f6cda | ||
|
|
80185463ea | ||
|
|
e87c785cc7 | ||
|
|
6414d3aef3 | ||
|
|
a259e8ab53 | ||
|
|
500403dbda | ||
|
|
066c1a5e62 | ||
|
|
1ab166b38b | ||
|
|
5efee20041 | ||
|
|
aa45e2fe93 | ||
|
|
e328f3969c | ||
|
|
9d1a416f99 | ||
|
|
9b065602a8 | ||
|
|
abf258e2e8 | ||
|
|
cdf92ea2b2 | ||
|
|
22d9baf296 | ||
|
|
44f174a571 | ||
|
|
3e945c75b4 | ||
|
|
a71fe82752 | ||
|
|
4f07a70ed1 | ||
|
|
cb660e044d | ||
|
|
d24c8c2d46 | ||
|
|
9ab54adf3f | ||
|
|
71d4cdc319 | ||
|
|
1374f21ba8 | ||
|
|
a9bb6b26fa | ||
|
|
561cadee0f | ||
|
|
5ca78fb871 | ||
|
|
f17082b337 | ||
|
|
1ea1be33ba | ||
|
|
47c6f4f2f8 | ||
|
|
dc1675766f | ||
|
|
ccac816f52 | ||
|
|
c7e8193514 | ||
|
|
36bd3a51a2 | ||
|
|
32777cc15c | ||
|
|
64c23f93f8 | ||
|
|
d19443052d | ||
|
|
df1e4a4616 | ||
|
|
3de1e607eb | ||
|
|
9b13aef1ce | ||
|
|
6dcae6d0c1 | ||
|
|
63b7602d3a | ||
|
|
b66de7f25c | ||
|
|
46047b2202 | ||
|
|
7cfe198d0f | ||
|
|
1aca17cd44 | ||
|
|
ea040ae5ee | ||
|
|
7741abd45d | ||
|
|
b5e52d31f5 | ||
|
|
deab695294 | ||
|
|
a54f084ffb | ||
|
|
bf0532867d | ||
|
|
9818c3f5d1 | ||
|
|
f0c40d348e | ||
|
|
4d6e0e26b6 | ||
|
|
6025b8f0ef | ||
|
|
c7edaaa7c5 | ||
|
|
2044c5c8eb | ||
|
|
f38f3cf09a | ||
|
|
6fd571ecb2 | ||
|
|
bf35c1659b | ||
|
|
b2230a6d6d | ||
|
|
6c20cd7819 | ||
|
|
f921aa47c4 | ||
|
|
532701031e | ||
|
|
b079d71f30 | ||
|
|
e2ca97ca47 | ||
|
|
5bc4f2a080 | ||
|
|
2c8dc2ffdd | ||
|
|
f3d7b3ab5e | ||
|
|
766ef320c2 | ||
|
|
e46f22a37c | ||
|
|
e5b1d7c3ca | ||
|
|
c4ededa9d0 | ||
|
|
5634157c8d | ||
|
|
1355765d14 | ||
|
|
152903e7df | ||
|
|
b1eedbb7ac | ||
|
|
002239f5b6 | ||
|
|
70b7c4db55 | ||
|
|
2cac21b345 | ||
|
|
6180f29f39 | ||
|
|
b4bfdd83e5 | ||
|
|
1140669ea7 | ||
|
|
919e2a2918 | ||
|
|
485a94765b | ||
|
|
2f45f8631b | ||
|
|
baffff3d93 | ||
|
|
25a603debe | ||
|
|
a20f0d47e7 | ||
|
|
76e04ee997 | ||
|
|
0a8debe43a | ||
|
|
8f6dc5fac2 | ||
|
|
7d40fde21d | ||
|
|
1760afbe97 | ||
|
|
60f90804d5 | ||
|
|
e02df3725e | ||
|
|
ac42d7b1dd | ||
|
|
697f325df6 | ||
|
|
58d00b16c6 | ||
|
|
425743939c | ||
|
|
7e48a0a742 | ||
|
|
4f9254ebb0 | ||
|
|
90657b706f | ||
|
|
23a39a6c54 | ||
|
|
873f190961 | ||
|
|
87cdd76f8d | ||
|
|
45fabb5214 | ||
|
|
a9182021bb | ||
|
|
a8f4009cb1 | ||
|
|
794080e386 | ||
|
|
818f7a78a0 | ||
|
|
939d7c9a89 | ||
|
|
92f7cde375 | ||
|
|
af178daa84 | ||
|
|
49777a379b | ||
|
|
5768238f66 | ||
|
|
4c4b2b282e | ||
|
|
9d11a99ed4 | ||
|
|
9bc8b540b3 | ||
|
|
af75364c54 | ||
|
|
1270498170 | ||
|
|
b387308455 | ||
|
|
aba9b29717 | ||
|
|
94ca610bff | ||
|
|
2542c0fda4 | ||
|
|
8482067b52 | ||
|
|
7319dab30f | ||
|
|
4bbba3ebd7 | ||
|
|
988021ff24 | ||
|
|
4e177ce926 | ||
|
|
1fa94d0372 | ||
|
|
0fcbdd74cd | ||
|
|
ba854379e4 | ||
|
|
a6cbd64e65 | ||
|
|
5c589dbf30 | ||
|
|
10e9c53e54 | ||
|
|
0332920a63 | ||
|
|
9b9dfbd198 | ||
|
|
5909e541b0 | ||
|
|
941ca6568a | ||
|
|
39a9c4e4ed | ||
|
|
41b4373494 | ||
|
|
4bf009a1ab | ||
|
|
e3d14dfb9e | ||
|
|
734724e407 | ||
|
|
a3a1dc52c5 | ||
|
|
6dddaaa77b | ||
|
|
12fc3ddc3d | ||
|
|
555d7433b7 | ||
|
|
b060787911 | ||
|
|
50951ef636 | ||
|
|
e1e1da18c6 | ||
|
|
47eba23460 | ||
|
|
f65e1ddaa1 | ||
|
|
02b46a0f85 | ||
|
|
636600f1c7 | ||
|
|
63aee06f6f | ||
|
|
7e4e2ed00e | ||
|
|
ee218171e7 | ||
|
|
8d3ebba561 | ||
|
|
09c72e8eed | ||
|
|
1541da5fbf | ||
|
|
257bf46e3b | ||
|
|
b53e0dd8b5 | ||
|
|
c23c4e2729 | ||
|
|
6f0f5feb34 | ||
|
|
27fafcd579 | ||
|
|
558bacfb0d | ||
|
|
bd6d4f3199 | ||
|
|
75d09c6349 | ||
|
|
bf59803015 | ||
|
|
5545078e0e | ||
|
|
c045b2af4a | ||
|
|
52f6900fc6 | ||
|
|
a71efa99fe | ||
|
|
c5a9d3a97d | ||
|
|
7b6eb0bd8d | ||
|
|
97fe836609 | ||
|
|
189a4170ec | ||
|
|
bfcb0b54e9 | ||
|
|
0153904ef2 | ||
|
|
ec52852bf5 | ||
|
|
01c7d09fdd | ||
|
|
b5c301eb05 | ||
|
|
ec9ab0da4d | ||
|
|
76eedf43bd | ||
|
|
094999a7f0 | ||
|
|
8bf1e30d66 | ||
|
|
90737f4ef6 | ||
|
|
21dcc11684 | ||
|
|
02ce9fc7ed | ||
|
|
a8c4129203 | ||
|
|
816c59d994 | ||
|
|
ee9ea93c2a | ||
|
|
eee6e596b1 | ||
|
|
537f9fec99 | ||
|
|
47acde313f | ||
|
|
97237e709b | ||
|
|
5aa3cfca1b | ||
|
|
a65f618a96 | ||
|
|
53747b8534 | ||
|
|
b4b96d9338 | ||
|
|
e5944b8af5 | ||
|
|
e9ba51c7b3 | ||
|
|
a42413223e | ||
|
|
cbb6b6183c | ||
|
|
de68e3f213 | ||
|
|
066002e864 | ||
|
|
f66238218d | ||
|
|
7b552ce0ba | ||
|
|
49f97711f6 | ||
|
|
2b60afe6c3 | ||
|
|
6bf1b33e4d | ||
|
|
6c3b687360 | ||
|
|
48fcdd744d | ||
|
|
cae178c7b2 | ||
|
|
b921f8ecbd | ||
|
|
b7eba989ad | ||
|
|
a67fec8662 | ||
|
|
65c23c5e0d | ||
|
|
8150483b70 | ||
|
|
594509cb00 | ||
|
|
ddbe050c1a | ||
|
|
debe35c477 | ||
|
|
1b72f31d50 | ||
|
|
9bb18b11ba | ||
|
|
019394c420 | ||
|
|
cc380f8e95 | ||
|
|
6b95ed7d9b | ||
|
|
5b2169672b | ||
|
|
64a65e3f6c | ||
|
|
baa4e78626 | ||
|
|
718b574519 | ||
|
|
859714ca70 | ||
|
|
867b7d37f4 | ||
|
|
76bb6b3c4a | ||
|
|
511aa802e5 | ||
|
|
871dea4348 | ||
|
|
434f1e2cc4 | ||
|
|
77fd14b89b | ||
|
|
1159659b4f | ||
|
|
274db9e4dc | ||
|
|
c51414f7ab | ||
|
|
eb6ba73525 | ||
|
|
f23df4cb48 | ||
|
|
44acd20726 | ||
|
|
51f1bf947a | ||
|
|
ea6411c730 | ||
|
|
d1447297c5 | ||
|
|
8b9a6c5f9a | ||
|
|
7af511a218 | ||
|
|
1188b6d9b3 | ||
|
|
54f56dac23 | ||
|
|
c42cd99d62 | ||
|
|
0bc626e1d3 | ||
|
|
3780cf1d98 | ||
|
|
7f2145a6d4 | ||
|
|
e786f26a05 | ||
|
|
8a84bfa2bf | ||
|
|
c119689ebc | ||
|
|
90bf65f117 | ||
|
|
3bfe62517b | ||
|
|
d644f8f76e | ||
|
|
6258d2398c | ||
|
|
4531532a07 | ||
|
|
ea6a260253 | ||
|
|
6541e3a95c | ||
|
|
7f378e445d | ||
|
|
6beaf49275 | ||
|
|
cbcb0507a2 | ||
|
|
f3614c9deb | ||
|
|
5a70bde74c | ||
|
|
9f55b2fec2 | ||
|
|
4d4c8e8ab9 | ||
|
|
bf71175d89 | ||
|
|
a96bbbc135 | ||
|
|
78a4f30951 | ||
|
|
68007052d5 | ||
|
|
086d93dd28 | ||
|
|
be0db4ebdf | ||
|
|
9b5c3cd23b | ||
|
|
e3ad1a8516 | ||
|
|
577b1886d5 | ||
|
|
534ca2043d | ||
|
|
f9cfc551c3 | ||
|
|
a9d444caf6 | ||
|
|
295a5cccf3 | ||
|
|
dab8aa9fa1 | ||
|
|
788211c794 | ||
|
|
d14bd31b4a | ||
|
|
11d8c090c8 | ||
|
|
e500a8a5b5 | ||
|
|
9e3eb0fdeb | ||
|
|
3a0c5428d6 | ||
|
|
0ebf9f1d1c | ||
|
|
c394470160 | ||
|
|
2d51afb3c1 | ||
|
|
07fe952426 |
+5
-3
@@ -12,11 +12,13 @@ config.log
|
||||
config.status
|
||||
|
||||
# generated folder
|
||||
include/
|
||||
modules/
|
||||
docs/src/tmp
|
||||
/include/
|
||||
/modules/
|
||||
/docs/src/tmp
|
||||
autom4te.cache
|
||||
|
||||
# the executable from tests
|
||||
runs
|
||||
|
||||
# Documentation temporary files
|
||||
docs/src/userguide.pdf
|
||||
|
||||
@@ -1,164 +0,0 @@
|
||||
Changelog. A lot less detailed than usual, at least for past
|
||||
history.
|
||||
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.
|
||||
@@ -1,10 +1,10 @@
|
||||
|
||||
|
||||
AMG4PSBLAS version 1.0
|
||||
AMG4PSBLAS version 1.2
|
||||
Algebraic Multigrid Package
|
||||
based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
based on PSBLAS (Parallel Sparse BLAS version 3.9)
|
||||
|
||||
(C) Copyright 2020
|
||||
(C) Copyright 2025
|
||||
|
||||
Salvatore Filippone
|
||||
Pasqua D'Ambra
|
||||
|
||||
+10
-8
@@ -2,10 +2,10 @@
|
||||
.mod=@MODEXT@
|
||||
.fh=.fh
|
||||
.SUFFIXES:
|
||||
.SUFFIXES: .f90 .F90 .f .F .c .o
|
||||
.SUFFIXES: .f90 .F90 .f .F .c .cpp .o
|
||||
##########################################################
|
||||
# #
|
||||
# Note: directories external to the MLD2P4 subtree #
|
||||
# Note: directories external to the AMG4PSBLAS subtree #
|
||||
# must be specified here with absolute pathnames #
|
||||
# #
|
||||
##########################################################
|
||||
@@ -16,6 +16,7 @@ PSBLAS_LIBDIR=@PSBLAS_LIBDIR@
|
||||
@PSBLAS_INSTALL_MAKEINC@
|
||||
PSBLAS_INCLUDES=@PSBLAS_INCLUDES@
|
||||
PSBLAS_LIBS=@PSBLAS_LIBS@
|
||||
PSBBASEMODNAME=psb_base_mod
|
||||
|
||||
|
||||
|
||||
@@ -69,15 +70,16 @@ EXTRALIBS=@EXTRA_LIBS@
|
||||
|
||||
|
||||
#
|
||||
MLDCDEFINES=$(MUMPSFLAGS) $(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS) $(PSBCDEFINES)
|
||||
MLDFDEFINES=@FDEFINES@ $(PSBFDEFINES)
|
||||
AMGCDEFINES=$(MUMPSFLAGS) $(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS) $(PSBCDEFINES)
|
||||
CDEFINES=$(AMGCDEFINES)
|
||||
AMGFDEFINES=@AMGFDEFINES@ $(PSBFDEFINES)
|
||||
FDEFINES=$(AMGFDEFINES)
|
||||
|
||||
CDEFINES=$(MLDCDEFINES)
|
||||
FDEFINES=$(MLDFDEFINES)
|
||||
CXXDEFINES=@AMGCXXDEFINES@ $(PSBCXXDEFINES)
|
||||
|
||||
@COMPILERULES@
|
||||
|
||||
|
||||
MLDLDLIBS=$(MUMPSLIBS) $(SLULIBS) $(SLUDISTLIBS) $(UMFLIBS) $(EXTRALIBS) $(PSBLDLIBS)
|
||||
LDLIBS=$(MLDLDLIBS)
|
||||
AMGLDLIBS=$(MUMPSLIBS) $(SLULIBS) $(SLUDISTLIBS) $(UMFLIBS) $(EXTRALIBS) $(PSBLDLIBS) -lstdc++
|
||||
LDLIBS=$(AMGLDLIBS)
|
||||
|
||||
|
||||
+120
@@ -0,0 +1,120 @@
|
||||
##########################################################
|
||||
.mod=@MODEXT@
|
||||
.fh=.fh
|
||||
.SUFFIXES:
|
||||
.SUFFIXES: .f90 .F90 .f .F .c .cpp .o
|
||||
# The following ones are the variables used by the PSBLAS make scripts.
|
||||
|
||||
FC=@FC@
|
||||
CC=@CC@
|
||||
CXX=@CXX@
|
||||
FCOPT=@FCOPT@
|
||||
CCOPT=@CCOPT@
|
||||
CXXOPT=@CXXOPT@
|
||||
FMFLAG=@FMFLAG@
|
||||
FIFLAG=@FIFLAG@
|
||||
EXTRA_OPT=@EXTRA_OPT@
|
||||
|
||||
# These three should be always set!
|
||||
MPFC=@MPIFC@
|
||||
MPCC=@MPICC@
|
||||
MPCXX=@MPICXX@
|
||||
|
||||
FLINK=@FLINK@
|
||||
|
||||
LIBS=@LIBS@
|
||||
|
||||
# BLAS, BLACS and METIS libraries.
|
||||
BLAS=@BLAS_LIBS@
|
||||
METIS_LIB=@METIS_LIBS@
|
||||
LAPACK=@LAPACK_LIBS@
|
||||
|
||||
PSBFDEFINES=@FDEFINES@
|
||||
PSBCDEFINES=@CDEFINES@
|
||||
PSBCXXDEFINES=@CDEFINES@
|
||||
AR=@AR@
|
||||
RANLIB=@RANLIB@
|
||||
|
||||
##########################################################
|
||||
# #
|
||||
# Note: directories external to the AMG4PSBLAS subtree #
|
||||
# must be specified here with absolute pathnames #
|
||||
# #
|
||||
##########################################################
|
||||
PSBLASDIR=@PSBLAS_DIR@
|
||||
PSBLAS_INCDIR=@PSBLAS_INCDIR@
|
||||
PSBLAS_MODDIR=@PSBLAS_MODDIR@
|
||||
PSBLAS_LIBDIR=@PSBLAS_LIBDIR@
|
||||
PSBLAS_INCLUDES=@PSBLAS_INCLUDES@
|
||||
PSBLAS_LIBS=@PSBLAS_LIBS@
|
||||
PSBBASEMODNAME=psb_base_mod
|
||||
PSBPRECMODNAME=psb_prec_mod
|
||||
PSBMETHDMODNAME=psb_linsolve_mod
|
||||
PSBUTILMODNAME=psb_util_mod
|
||||
|
||||
|
||||
|
||||
|
||||
INSTALL=@INSTALL@
|
||||
INSTALL_DATA=@INSTALL_DATA@
|
||||
INSTALL_DIR=@INSTALL_DIR@
|
||||
INSTALL_LIBDIR=@INSTALL_LIBDIR@
|
||||
INSTALL_INCLUDEDIR=@INSTALL_INCLUDEDIR@
|
||||
INSTALL_MODULESDIR=@INSTALL_MODULESDIR@
|
||||
INSTALL_DOCSDIR=@INSTALL_DOCSDIR@
|
||||
INSTALL_SAMPLESDIR=@INSTALL_SAMPLESDIR@
|
||||
|
||||
|
||||
##########################################################
|
||||
# #
|
||||
# Additional defines and libraries for multilevel #
|
||||
# Note that these libraries should be compatible #
|
||||
# (compiled with) the compilers specified in the #
|
||||
# PSBLAS main Make.inc #
|
||||
# #
|
||||
# Examples: #
|
||||
# MUMPSLIBS=-ldmumps -lmumps_common #
|
||||
# -lpord -L/path/to/MUMPS/lib #
|
||||
# MUMPSFLAGS=-DHave_MUMPS_ -I/path/to/MUMPS/include #
|
||||
# #
|
||||
# UMFLIBS=-lumfpack -lamd -L/path/to/UMFPACK #
|
||||
# UMFFLAGS=-DHave_UMF_ -I/path/to/UMFPACK #
|
||||
# #
|
||||
# SLULIBS=-lslu -L/path/to/SuperLU #
|
||||
# SLUFLAGS=-DHave_SLU_ -I/path/to/SuperLU #
|
||||
# #
|
||||
# SLUDISTLIBS=-lslud -L/path/to/SuperLUDist #
|
||||
# SLUDISTFLAGS=-DHave_SLUDist_ -I/path/to/SuperLUDist #
|
||||
# #
|
||||
##########################################################
|
||||
|
||||
MUMPSLIBS=@MUMPS_LIBS@
|
||||
MUMPSFLAGS=@MUMPS_FLAGS@
|
||||
|
||||
SLULIBS=@SLU_LIBS@
|
||||
SLUFLAGS=@SLU_FLAGS@
|
||||
|
||||
SLUDISTLIBS=@SLUDIST_LIBS@
|
||||
SLUDISTFLAGS=@SLUDIST_FLAGS@
|
||||
|
||||
UMFLIBS=@UMF_LIBS@
|
||||
UMFFLAGS=@UMF_FLAGS@
|
||||
|
||||
EXTRALIBS=@EXTRA_LIBS@
|
||||
|
||||
|
||||
|
||||
@COMPILERULES@
|
||||
|
||||
#
|
||||
AMGCDEFINES=$(MUMPSFLAGS) $(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS) $(PSBCDEFINES)
|
||||
CDEFINES=$(AMGCDEFINES)
|
||||
AMGFDEFINES=@AMGFDEFINES@ $(PSBFDEFINES)
|
||||
FDEFINES=$(AMGFDEFINES)
|
||||
|
||||
CXXDEFINES=@AMGCXXDEFINES@ $(PSBCXXDEFINES)
|
||||
|
||||
AMGLDLIBS=$(MUMPSLIBS) $(SLULIBS) $(SLUDISTLIBS) $(UMFLIBS) $(EXTRALIBS) $(PSBLDLIBS) -lstdc++
|
||||
LDLIBS=$(AMGLDLIBS)
|
||||
|
||||
|
||||
@@ -1,10 +1,13 @@
|
||||
include Make.inc
|
||||
|
||||
|
||||
all: library
|
||||
all: objs lib
|
||||
|
||||
library: libdir amgp
|
||||
#cbnd
|
||||
objs: libdir amgp cbnd
|
||||
|
||||
lib: objs
|
||||
cd amgprec && $(MAKE) lib
|
||||
cd cbind && $(MAKE) lib
|
||||
|
||||
libdir:
|
||||
(if test ! -d lib ; then mkdir lib; fi)
|
||||
@@ -14,10 +17,11 @@ libdir:
|
||||
|
||||
|
||||
amgp:
|
||||
$(MAKE) -C amgprec all
|
||||
cd amgprec && $(MAKE) objs
|
||||
cbnd: amgp
|
||||
$(MAKE) -C cbind all
|
||||
install: all
|
||||
cd cbind && $(MAKE) objs
|
||||
|
||||
install: lib
|
||||
mkdir -p $(INSTALL_LIBDIR) &&\
|
||||
$(INSTALL_DATA) lib/*.a $(INSTALL_LIBDIR)
|
||||
mkdir -p $(INSTALL_INCLUDEDIR) &&\
|
||||
@@ -33,22 +37,25 @@ install: all
|
||||
mkdir -p $(INSTALL_SAMPLESDIR) && \
|
||||
mkdir -p $(INSTALL_SAMPLESDIR)/simple &&\
|
||||
mkdir -p $(INSTALL_SAMPLESDIR)/advanced && \
|
||||
(cd examples; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/simple ) && \
|
||||
(cd tests; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/advanced )
|
||||
(cd samples/simple; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/simple ) && \
|
||||
(cd samples/advanced; /bin/cp -fr pdegen fileread $(INSTALL_SAMPLESDIR)/advanced )
|
||||
cleanlib:
|
||||
(cd lib; /bin/rm -f *.a *$(.mod) *$(.fh))
|
||||
(cd include; /bin/rm -f *.a *$(.mod) *$(.fh))
|
||||
(cd modules; /bin/rm -f *.a *$(.mod) *$(.fh))
|
||||
|
||||
veryclean: cleanlib
|
||||
(cd amgprec; make veryclean)
|
||||
(cd examples/fileread; make clean)
|
||||
(cd examples/pdegen; make clean)
|
||||
(cd tests/fileread; make clean)
|
||||
(cd tests/pdegen; make clean)
|
||||
distclean: clean samplesclean
|
||||
/bin/rm -fr Make.inc
|
||||
|
||||
samplesclean: clean
|
||||
(cd samples/simple/fileread && $(MAKE) clean)
|
||||
(cd samples/simple/pdegen && $(MAKE) clean)
|
||||
(cd samples/advanced/fileread && $(MAKE) clean)
|
||||
(cd samples/advanced/pdegen && $(MAKE) clean)
|
||||
|
||||
check: all
|
||||
make check -C tests/pdegen
|
||||
make check -C samples/advanced/pdegen
|
||||
|
||||
clean:
|
||||
(cd amgprec; make clean)
|
||||
clean: cleanlib
|
||||
(cd amgprec && $(MAKE) clean)
|
||||
(cd cbind && $(MAKE) clean)
|
||||
|
||||
@@ -1,55 +1,76 @@
|
||||
# AMG4PSBLAS v1.2
|
||||
Algebraic Multigrid Package based on [PSBLAS](https://github.com/sfilippone/psblas3) (Parallel Sparse BLAS version 3.9)
|
||||
|
||||
AMG4PSBLAS
|
||||
Algebraic Multigrid Package based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
|
||||
Salvatore Filippone (University of Rome Tor Vergata and IAC-CNR)
|
||||
Pasqua D'Ambra (IAC-CNR, Naples, IT)
|
||||
Fabio Durastante (IAC-CNR, Naples, IT)
|
||||
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.
|
||||
|
||||
AMG4PSBLAS is a package of Algebraic MultiGrid (AMG)
|
||||
preconditioners for the iterative solution of large and sparse linear systems.
|
||||
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.
|
||||
|
||||
It is an evolution of MLD2P4 (see LICENSE.MLD2P4), but it has been
|
||||
thoroughly reworked, and it is sufficiently different to warrant a new
|
||||
project name.
|
||||
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.
|
||||
|
||||
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.
|
||||
|
||||
MAIN REFERENCES:
|
||||
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.
|
||||
|
||||
P. D'Ambra, D. di Serafino, S. Filippone,
|
||||
MLD2P4: a Package of Parallel Algebraic Multilevel Domain Decomposition
|
||||
Preconditioners in Fortran 95,
|
||||
ACM Transactions on Mathematical Software, 37 (3), 2010, art. 30,
|
||||
doi: 10.1145/1824801.1824808.
|
||||
## Main Refrerences:
|
||||
|
||||
The main reference for this project is
|
||||
> D'Ambra, P., Durastante, F., & Filippone, S. (2021). AMG preconditioners for linear solvers towards extreme scale. SIAM Journal on Scientific Computing, 43(5), S679-S703.
|
||||
|
||||
TO COMPILE
|
||||
AMG4PSBLAS is the suite of preconditioners for the Parallel Sparse Computation Toolkit ([PSCToolkit](https://psctoolkit.github.io/)) suite of libraries. See the paper:
|
||||
> D’Ambra, P., Durastante, F., & Filippone, S. (2023). Parallel Sparse Computation Toolkit. Software Impacts, 15, 100463.
|
||||
|
||||
The main reference for features inherited from MLD2P4 is
|
||||
> P. D'Ambra, D. di Serafino, S. Filippone,
|
||||
> MLD2P4: a Package of Parallel Algebraic Multilevel Domain Decomposition
|
||||
> Preconditioners in Fortran 95,
|
||||
> ACM Transactions on Mathematical Software, 37 (3), 2010, art. 30,
|
||||
> doi: 10.1145/1824801.1824808.
|
||||
|
||||
## Installing
|
||||
|
||||
Installation requires having a working version of the [PSBLAS](https://github.com/sfilippone/psblas3) library installed.
|
||||
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. This is _not mandatory_ and the library can run
|
||||
in isolation and without these features.
|
||||
|
||||
0. Unpack the tar file in a directory of your choice (preferrably
|
||||
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>`
|
||||
adding the options for MUMPS, SuperLU, SuperLU_Dist, UMFPACK as desired.
|
||||
See MLD2P4 User's and Reference Guide (Section 3) for details.
|
||||
2. Tweak Make.inc if you are not satisfied.
|
||||
3. make;
|
||||
See [AMG4PSBLAS User's and Reference Guide](docs/amg4psblas_1.0-guide.pdf) (Section 3) for details.
|
||||
2. Tweak `Make.inc` if you are not satisfied.
|
||||
3. run `make`;
|
||||
4. Go into the test subdirectory and build the examples of your choice.
|
||||
5. (if desired): make install
|
||||
5. (if desired): `make install`
|
||||
|
||||
>[!CAUTION]
|
||||
>The single precision version is supported only by MUMPS and SuperLU;
|
||||
>thus, even if you specify at configure time to use UMFPACK or SuperLU_Dist,
|
||||
>the corresponding preconditioner options will be available only from
|
||||
>the double precision version.
|
||||
|
||||
NOTES
|
||||
### CUDA, OpeMP, OpenACC
|
||||
|
||||
- The single precision version is supported only by MUMPS and SuperLU;
|
||||
thus, even if you specify at configure time to use UMFPACK or SuperLU_Dist,
|
||||
the corresponding preconditioner options will be available only from
|
||||
the double precision version.
|
||||
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. See also the samples/cuda folder.
|
||||
|
||||
### 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.
|
||||
|
||||
## TODO and bugs
|
||||
|
||||
- [X] Fix all reamining bugs. Bugs? We dont' have any ! 🤓
|
||||
|
||||
> [!NOTE]
|
||||
> To report bugs 🐛 or issues ❓ please use the [GitHub issue system](https://github.com/sfilippone/amg4psblas/issues).
|
||||
|
||||
## The AMG4PSBLAS team.
|
||||
|
||||
- Pasqua D'Ambra (IAC-CNR, Naples, IT)
|
||||
- Fabio Durastante (University of Pisa and IAC-CNR, IT)
|
||||
- Salvatore Filippone (University of Rome Tor Vergata and IAC-CNR, IT)
|
||||
|
||||
The AMG4PSBLAS team.
|
||||
---------------
|
||||
Salvatore Filippone
|
||||
Pasqua D'Ambra
|
||||
Fabio Durastante
|
||||
|
||||
+14
@@ -1,5 +1,19 @@
|
||||
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
|
||||
1. The multigrid preconditioner now include fully general V- and
|
||||
W-cycles. We also support K-cycles, both for symmetric and
|
||||
|
||||
+48
-39
@@ -9,48 +9,46 @@ FINCLUDES=$(FMFLAG)$(HERE) $(FMFLAG)$(INCDIR) $(PSBLAS_INCLUDES)
|
||||
|
||||
DMODOBJS=amg_d_prec_type.o \
|
||||
amg_d_inner_mod.o amg_d_ilu_solver.o amg_d_diag_solver.o amg_d_jac_smoother.o amg_d_as_smoother.o \
|
||||
amg_d_poly_smoother.o amg_d_poly_coeff_mod.o\
|
||||
amg_d_umf_solver.o amg_d_slu_solver.o amg_d_sludist_solver.o amg_d_id_solver.o\
|
||||
amg_d_base_solver_mod.o amg_d_base_smoother_mod.o amg_d_onelev_mod.o \
|
||||
amg_d_gs_solver.o amg_d_mumps_solver.o \
|
||||
amg_d_gs_solver.o amg_d_mumps_solver.o amg_d_jac_solver.o \
|
||||
amg_d_base_aggregator_mod.o \
|
||||
amg_d_dec_aggregator_mod.o amg_d_symdec_aggregator_mod.o \
|
||||
amg_d_ainv_solver.o amg_d_base_ainv_mod.o \
|
||||
amg_d_invk_solver.o amg_d_invt_solver.o \
|
||||
amg_d_rkr_solver.o
|
||||
#amg_d_bcmatch_aggregator_mod.o
|
||||
amg_d_invk_solver.o amg_d_invt_solver.o amg_d_krm_solver.o \
|
||||
amg_d_matchboxp_mod.o amg_d_parmatch_aggregator_mod.o
|
||||
|
||||
SMODOBJS=amg_s_prec_type.o amg_s_ilu_fact_mod.o \
|
||||
amg_s_inner_mod.o amg_s_ilu_solver.o amg_s_diag_solver.o amg_s_jac_smoother.o amg_s_as_smoother.o \
|
||||
amg_s_slu_solver.o amg_s_id_solver.o\
|
||||
amg_s_poly_smoother.o amg_s_slu_solver.o amg_s_id_solver.o\
|
||||
amg_s_base_solver_mod.o amg_s_base_smoother_mod.o amg_s_onelev_mod.o \
|
||||
amg_s_gs_solver.o amg_s_mumps_solver.o \
|
||||
amg_s_gs_solver.o amg_s_mumps_solver.o amg_s_jac_solver.o \
|
||||
amg_s_base_aggregator_mod.o \
|
||||
amg_s_dec_aggregator_mod.o amg_s_symdec_aggregator_mod.o \
|
||||
amg_s_ainv_solver.o amg_s_base_ainv_mod.o \
|
||||
amg_s_invk_solver.o amg_s_invt_solver.o \
|
||||
amg_s_rkr_solver.o
|
||||
amg_s_invk_solver.o amg_s_invt_solver.o amg_s_krm_solver.o \
|
||||
amg_s_matchboxp_mod.o amg_s_parmatch_aggregator_mod.o
|
||||
|
||||
ZMODOBJS=amg_z_prec_type.o amg_z_ilu_fact_mod.o \
|
||||
amg_z_inner_mod.o amg_z_ilu_solver.o amg_z_diag_solver.o amg_z_jac_smoother.o amg_z_as_smoother.o \
|
||||
amg_z_umf_solver.o amg_z_slu_solver.o amg_z_sludist_solver.o amg_z_id_solver.o\
|
||||
amg_z_base_solver_mod.o amg_z_base_smoother_mod.o amg_z_onelev_mod.o \
|
||||
amg_z_gs_solver.o amg_z_mumps_solver.o \
|
||||
amg_z_gs_solver.o amg_z_mumps_solver.o amg_z_jac_solver.o \
|
||||
amg_z_base_aggregator_mod.o \
|
||||
amg_z_dec_aggregator_mod.o amg_z_symdec_aggregator_mod.o \
|
||||
amg_z_ainv_solver.o amg_z_base_ainv_mod.o \
|
||||
amg_z_invk_solver.o amg_z_invt_solver.o \
|
||||
amg_z_rkr_solver.o
|
||||
amg_z_invk_solver.o amg_z_invt_solver.o amg_z_krm_solver.o
|
||||
|
||||
CMODOBJS=amg_c_prec_type.o amg_c_ilu_fact_mod.o \
|
||||
amg_c_inner_mod.o amg_c_ilu_solver.o amg_c_diag_solver.o amg_c_jac_smoother.o amg_c_as_smoother.o \
|
||||
amg_c_slu_solver.o amg_c_id_solver.o\
|
||||
amg_c_base_solver_mod.o amg_c_base_smoother_mod.o amg_c_onelev_mod.o \
|
||||
amg_c_gs_solver.o amg_c_mumps_solver.o \
|
||||
amg_c_gs_solver.o amg_c_mumps_solver.o amg_c_jac_solver.o \
|
||||
amg_c_base_aggregator_mod.o \
|
||||
amg_c_dec_aggregator_mod.o amg_c_symdec_aggregator_mod.o \
|
||||
amg_c_ainv_solver.o amg_c_base_ainv_mod.o \
|
||||
amg_c_invk_solver.o amg_c_invt_solver.o \
|
||||
amg_c_rkr_solver.o
|
||||
amg_c_invk_solver.o amg_c_invt_solver.o amg_c_krm_solver.o
|
||||
|
||||
|
||||
|
||||
@@ -65,25 +63,37 @@ OBJS=$(MODOBJS)
|
||||
LOCAL_MODS=$(MODOBJS:.o=$(.mod))
|
||||
LIBNAME=libamg_prec.a
|
||||
|
||||
all: lib impld
|
||||
all: objs impld
|
||||
|
||||
impld: $(OBJS)
|
||||
$(MAKE) -C impl
|
||||
|
||||
lib: $(OBJS) impld
|
||||
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
/bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR)
|
||||
objs: $(OBJS)
|
||||
/bin/cp -p amg_const.h $(INCDIR)
|
||||
/bin/cp -p *$(.mod) $(MODDIR)
|
||||
|
||||
impld: objs
|
||||
cd impl && $(MAKE)
|
||||
|
||||
$(MODOBJS): $(PSBLAS_MODDIR)/$(BASEMODNAME)$(.mod)
|
||||
lib: $(OBJS) impld
|
||||
cd impl && $(MAKE) lib
|
||||
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
/bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR)
|
||||
|
||||
|
||||
$(MODOBJS): $(PSBLAS_MODDIR)/$(PSBBASEMODNAME)$(.mod)
|
||||
|
||||
amg_base_prec_type.o: amg_const.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_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_s_krm_solver.o: amg_s_prec_type.o amg_s_base_solver_mod.o
|
||||
amg_d_krm_solver.o: amg_d_prec_type.o amg_d_base_solver_mod.o
|
||||
amg_c_krm_solver.o: amg_c_prec_type.o amg_c_base_solver_mod.o
|
||||
amg_z_krm_solver.o: amg_z_prec_type.o amg_z_base_solver_mod.o
|
||||
|
||||
amg_s_prec_mod.o: amg_s_krm_solver.o
|
||||
amg_d_prec_mod.o: amg_d_krm_solver.o
|
||||
amg_c_prec_mod.o: amg_c_krm_solver.o
|
||||
amg_z_prec_mod.o: amg_z_krm_solver.o
|
||||
|
||||
$(SINNEROBJS) $(SOUTEROBJS): $(SMODOBJS)
|
||||
$(DINNEROBJS) $(DOUTEROBJS): $(DMODOBJS)
|
||||
@@ -106,25 +116,27 @@ amg_d_prec_type.o: amg_d_onelev_mod.o
|
||||
amg_c_prec_type.o: amg_c_onelev_mod.o
|
||||
amg_z_prec_type.o: amg_z_onelev_mod.o
|
||||
|
||||
amg_s_onelev_mod.o: amg_s_base_smoother_mod.o amg_s_dec_aggregator_mod.o
|
||||
amg_d_onelev_mod.o: amg_d_base_smoother_mod.o amg_d_dec_aggregator_mod.o
|
||||
amg_s_onelev_mod.o: amg_s_base_smoother_mod.o amg_s_dec_aggregator_mod.o amg_s_parmatch_aggregator_mod.o
|
||||
amg_d_onelev_mod.o: amg_d_base_smoother_mod.o amg_d_dec_aggregator_mod.o amg_d_parmatch_aggregator_mod.o
|
||||
amg_c_onelev_mod.o: amg_c_base_smoother_mod.o amg_c_dec_aggregator_mod.o
|
||||
amg_z_onelev_mod.o: amg_z_base_smoother_mod.o amg_z_dec_aggregator_mod.o
|
||||
|
||||
amg_s_base_aggregator_mod.o: amg_base_prec_type.o
|
||||
amg_s_dec_aggregator_mod.o: amg_s_base_aggregator_mod.o
|
||||
amg_s_parmatch_aggregator_mod.o amg_s_dec_aggregator_mod.o: amg_s_base_aggregator_mod.o
|
||||
amg_s_hybrid_aggregator_mod.o amg_s_symdec_aggregator_mod.o: amg_s_dec_aggregator_mod.o
|
||||
amg_s_parmatch_aggregator_mod.o: amg_s_matchboxp_mod.o
|
||||
|
||||
amg_d_base_aggregator_mod.o: amg_base_prec_type.o
|
||||
amg_d_dec_aggregator_mod.o: amg_d_base_aggregator_mod.o
|
||||
amg_d_parmatch_aggregator_mod.o amg_d_dec_aggregator_mod.o: amg_d_base_aggregator_mod.o
|
||||
amg_d_hybrid_aggregator_mod.o amg_d_symdec_aggregator_mod.o: amg_d_dec_aggregator_mod.o
|
||||
amg_d_parmatch_aggregator_mod.o: amg_d_matchboxp_mod.o
|
||||
|
||||
amg_c_base_aggregator_mod.o: amg_base_prec_type.o
|
||||
amg_c_dec_aggregator_mod.o: amg_c_base_aggregator_mod.o
|
||||
amg_c_parmatch_aggregator_mod.o amg_c_dec_aggregator_mod.o: amg_c_base_aggregator_mod.o
|
||||
amg_c_hybrid_aggregator_mod.o amg_c_symdec_aggregator_mod.o: amg_c_dec_aggregator_mod.o
|
||||
|
||||
amg_z_base_aggregator_mod.o: amg_base_prec_type.o
|
||||
amg_z_dec_aggregator_mod.o: amg_z_base_aggregator_mod.o
|
||||
amg_z_parmatch_aggregator_mod.o amg_z_dec_aggregator_mod.o: amg_z_base_aggregator_mod.o
|
||||
amg_z_hybrid_aggregator_mod.o amg_z_symdec_aggregator_mod.o: amg_z_dec_aggregator_mod.o
|
||||
|
||||
amg_s_base_smoother_mod.o: amg_s_base_solver_mod.o
|
||||
@@ -141,15 +153,10 @@ amg_c_base_ainv_mod.o: amg_c_base_solver_mod.o amg_base_ainv_mod.o
|
||||
amg_d_base_ainv_mod.o: amg_d_base_solver_mod.o amg_base_ainv_mod.o
|
||||
amg_z_base_ainv_mod.o: amg_z_base_solver_mod.o amg_base_ainv_mod.o
|
||||
|
||||
amg_d_rkr_solver.o: amg_d_base_solver_mod.o amg_d_prec_type.o
|
||||
amg_s_rkr_solver.o: amg_s_base_solver_mod.o amg_s_prec_type.o
|
||||
amg_c_rkr_solver.o: amg_c_base_solver_mod.o amg_c_prec_type.o
|
||||
amg_z_rkr_solver.o: amg_z_base_solver_mod.o amg_z_prec_type.o
|
||||
|
||||
amg_s_base_solver_mod.o amg_d_base_solver_mod.o amg_c_base_solver_mod.o amg_z_base_solver_mod.o: amg_base_prec_type.o
|
||||
|
||||
amg_d_mumps_solver.o amg_d_gs_solver.o amg_d_id_solver.o amg_d_sludist_solver.o amg_d_slu_solver.o \
|
||||
amg_d_umf_solver.o amg_d_diag_solver.o amg_d_ilu_solver.o: amg_d_base_solver_mod.o amg_d_prec_type.o
|
||||
amg_d_umf_solver.o amg_d_diag_solver.o amg_d_ilu_solver.o amg_d_jac_solver.o: amg_d_base_solver_mod.o amg_d_prec_type.o
|
||||
|
||||
#amg_d_ilu_fact_mod.o: amg_base_prec_type.o amg_d_base_solver_mod.o
|
||||
#amg_d_ilu_solver.o amg_d_iluk_fact.o: amg_d_ilu_fact_mod.o
|
||||
@@ -158,9 +165,11 @@ amg_d_jac_smoother.o: amg_d_diag_solver.o
|
||||
amg_dprecinit.o amg_dprecset.o: amg_d_diag_solver.o amg_d_ilu_solver.o \
|
||||
amg_d_umf_solver.o amg_d_as_smoother.o amg_d_jac_smoother.o \
|
||||
amg_d_id_solver.o amg_d_slu_solver.o amg_d_sludist_solver.o
|
||||
amg_d_poly_smoother.o: amg_d_base_smoother_mod.o amg_d_poly_coeff_mod.o
|
||||
amg_s_poly_smoother.o: amg_s_base_smoother_mod.o amg_d_poly_coeff_mod.o
|
||||
|
||||
amg_s_mumps_solver.o amg_s_gs_solver.o amg_s_id_solver.o amg_s_slu_solver.o \
|
||||
amg_s_diag_solver.o amg_s_ilu_solver.o: amg_s_base_solver_mod.o amg_s_prec_type.o
|
||||
amg_s_diag_solver.o amg_s_ilu_solver.o amg_s_jac_solver.o: amg_s_base_solver_mod.o amg_s_prec_type.o
|
||||
amg_s_ilu_fact_mod.o: amg_base_prec_type.o amg_s_base_solver_mod.o
|
||||
amg_s_ilu_solver.o amg_s_iluk_fact.o: amg_s_ilu_fact_mod.o
|
||||
amg_s_as_smoother.o amg_s_jac_smoother.o: amg_s_base_smoother_mod.o
|
||||
@@ -170,7 +179,7 @@ amg_sprecinit.o amg_sprecset.o: amg_s_diag_solver.o amg_s_ilu_solver.o \
|
||||
amg_s_id_solver.o amg_s_slu_solver.o
|
||||
|
||||
amg_z_mumps_solver.o amg_z_gs_solver.o amg_z_id_solver.o amg_z_sludist_solver.o amg_z_slu_solver.o \
|
||||
amg_z_umf_solver.o amg_z_diag_solver.o amg_z_ilu_solver.o: amg_z_base_solver_mod.o amg_z_prec_type.o
|
||||
amg_z_umf_solver.o amg_z_diag_solver.o amg_z_ilu_solver.o amg_z_jac_solver.o: amg_z_base_solver_mod.o amg_z_prec_type.o
|
||||
amg_z_ilu_fact_mod.o: amg_base_prec_type.o amg_z_base_solver_mod.o
|
||||
amg_z_ilu_solver.o amg_z_iluk_fact.o: amg_z_ilu_fact_mod.o
|
||||
amg_z_as_smoother.o amg_z_jac_smoother.o: amg_z_base_smoother_mod.o
|
||||
@@ -180,7 +189,7 @@ amg_zprecinit.o amg_zprecset.o: amg_z_diag_solver.o amg_z_ilu_solver.o \
|
||||
amg_z_id_solver.o amg_z_slu_solver.o amg_z_sludist_solver.o
|
||||
|
||||
amg_c_mumps_solver.o amg_c_gs_solver.o amg_c_id_solver.o amg_c_sludist_solver.o amg_c_slu_solver.o \
|
||||
amg_c_diag_solver.o amg_c_ilu_solver.o: amg_c_base_solver_mod.o amg_c_prec_type.o
|
||||
amg_c_diag_solver.o amg_c_ilu_solver.o amg_c_jac_solver.o: amg_c_base_solver_mod.o amg_c_prec_type.o
|
||||
amg_c_ilu_fact_mod.o: amg_base_prec_type.o amg_c_base_solver_mod.o
|
||||
amg_c_ilu_solver.o amg_c_iluk_fact.o: amg_c_ilu_fact_mod.o
|
||||
amg_c_as_smoother.o amg_c_jac_smoother.o: amg_c_base_smoother_mod.o
|
||||
@@ -215,4 +224,4 @@ clean: implclean
|
||||
/bin/rm -f $(OBJS) $(LOCAL_MODS) *$(.mod)
|
||||
|
||||
implclean:
|
||||
$(MAKE) -C impl clean
|
||||
cd impl && $(MAKE) clean
|
||||
|
||||
@@ -1,13 +1,13 @@
|
||||
#!/bin/bash
|
||||
hn=mld_const.h
|
||||
fn=mld_base_prec_type.F90
|
||||
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 MLD_CONST_H_' >> $hn
|
||||
echo '#define MLD_CONST_H_' >> $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 ^MLD | sed 's/^/#define /g' >> $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
|
||||
+411
-232
File diff suppressed because it is too large
Load Diff
@@ -1,11 +1,14 @@
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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
|
||||
@@ -55,13 +58,10 @@ module amg_c_ainv_solver
|
||||
procedure, pass(sv) :: check => amg_c_ainv_solver_check
|
||||
procedure, pass(sv) :: build => amg_c_ainv_solver_bld
|
||||
procedure, pass(sv) :: clone => amg_c_ainv_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_c_ainv_solver_clone_settings
|
||||
procedure, pass(sv) :: cseti => amg_c_ainv_solver_cseti
|
||||
procedure, pass(sv) :: csetc => amg_c_ainv_solver_csetc
|
||||
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
|
||||
generic, public :: set => seti, setr, setc
|
||||
procedure, pass(sv) :: descr => amg_c_ainv_solver_descr
|
||||
procedure, pass(sv) :: default => c_ainv_solver_default
|
||||
procedure, nopass :: stringval => c_ainv_stringval
|
||||
@@ -83,6 +83,16 @@ module amg_c_ainv_solver
|
||||
end subroutine amg_c_ainv_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_ainv_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& amg_c_base_solver_type, psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_c_ainv_solver_type), intent(inout) :: sv
|
||||
class(amg_c_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_ainv_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
@@ -159,44 +169,44 @@ module amg_c_ainv_solver
|
||||
end subroutine amg_c_ainv_solver_csetr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_ainv_solver_setc(sv,what,val,info)
|
||||
import :: amg_c_ainv_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_c_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_ainv_solver_setc
|
||||
end interface
|
||||
!!$ interface
|
||||
!!$ subroutine amg_c_ainv_solver_setc(sv,what,val,info)
|
||||
!!$ import :: amg_c_ainv_solver_type, psb_ipk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_c_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ character(len=*), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_c_ainv_solver_setc
|
||||
!!$ end interface
|
||||
!!$
|
||||
!!$ interface
|
||||
!!$ subroutine amg_c_ainv_solver_seti(sv,what,val,info)
|
||||
!!$ import :: amg_c_ainv_solver_type, psb_ipk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_c_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ integer(psb_ipk_), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_c_ainv_solver_seti
|
||||
!!$ end interface
|
||||
!!$
|
||||
!!$ interface
|
||||
!!$ subroutine amg_c_ainv_solver_setr(sv,what,val,info)
|
||||
!!$ import :: amg_c_ainv_solver_type, psb_ipk_, psb_spk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_c_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ real(psb_spk_), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_c_ainv_solver_setr
|
||||
!!$ end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_ainv_solver_seti(sv,what,val,info)
|
||||
import :: amg_c_ainv_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_c_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_ainv_solver_seti
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_ainv_solver_setr(sv,what,val,info)
|
||||
import :: amg_c_ainv_solver_type, psb_ipk_, psb_spk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_c_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_ainv_solver_setr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse)
|
||||
subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse,prefix)
|
||||
import :: psb_dpk_, amg_c_ainv_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -206,7 +216,7 @@ module amg_c_ainv_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_c_ainv_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -396,21 +396,23 @@ contains
|
||||
end subroutine c_as_smoother_default
|
||||
|
||||
|
||||
subroutine c_as_smoother_descr(sm,info,iout,coarse)
|
||||
subroutine c_as_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_as_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_as_smoother_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
logical :: coarse_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -424,16 +426,21 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (.not.coarse_) then
|
||||
write(iout_,*) ' Additive Schwarz with ',&
|
||||
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
|
||||
& sm%novr, ' overlap layers.'
|
||||
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) ' Local solver:'
|
||||
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) trim(prefix_), ' Local solver:'
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%descr(info,iout_,coarse=coarse)
|
||||
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -126,7 +126,7 @@ module amg_c_base_aggregator_mod
|
||||
& psb_c_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
|
||||
implicit none
|
||||
type(psb_c_csr_sparse_mat), intent(inout) :: a_csr
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_c_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
|
||||
@@ -144,7 +144,7 @@ module amg_c_base_aggregator_mod
|
||||
& psb_c_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
|
||||
implicit none
|
||||
type(psb_c_csr_sparse_mat), intent(inout) :: a_csr
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_c_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
|
||||
@@ -275,15 +275,22 @@ contains
|
||||
val = .false.
|
||||
end function amg_c_base_aggregator_xt_desc
|
||||
|
||||
subroutine amg_c_base_aggregator_descr(ag,parms,iout,info)
|
||||
subroutine amg_c_base_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
implicit none
|
||||
class(amg_c_base_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
|
||||
return
|
||||
end subroutine amg_c_base_aggregator_descr
|
||||
|
||||
@@ -1,11 +1,14 @@
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -272,7 +272,7 @@ module amg_c_base_smoother_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_base_smoother_descr(sm,info,iout,coarse)
|
||||
subroutine amg_c_base_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
& amg_c_base_smoother_type, psb_ipk_
|
||||
@@ -281,6 +281,7 @@ module amg_c_base_smoother_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_c_base_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -270,7 +270,7 @@ module amg_c_base_solver_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_base_solver_descr(sv,info,iout,coarse)
|
||||
subroutine amg_c_base_solver_descr(sv,info,iout,coarse,prefix)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
& amg_c_base_solver_type, psb_ipk_
|
||||
@@ -281,7 +281,7 @@ module amg_c_base_solver_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_c_base_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -184,16 +184,23 @@ contains
|
||||
val = "Decoupled aggregation"
|
||||
end function amg_c_dec_aggregator_fmt
|
||||
|
||||
subroutine amg_c_dec_aggregator_descr(ag,parms,iout,info)
|
||||
subroutine amg_c_dec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
implicit none
|
||||
class(amg_c_dec_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) 'Decoupled Aggregator'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
|
||||
return
|
||||
end subroutine amg_c_dec_aggregator_descr
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -219,7 +219,7 @@ contains
|
||||
|
||||
end subroutine c_diag_solver_free
|
||||
|
||||
subroutine c_diag_solver_descr(sv,info,iout,coarse)
|
||||
subroutine c_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -228,11 +228,13 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -240,8 +242,13 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
|
||||
write(iout_,*) ' Diagonal local solver '
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Diagonal local solver '
|
||||
|
||||
return
|
||||
|
||||
@@ -352,7 +359,7 @@ module amg_c_l1_diag_solver
|
||||
|
||||
contains
|
||||
|
||||
subroutine c_l1_diag_solver_descr(sv,info,iout,coarse)
|
||||
subroutine c_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -361,11 +368,13 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_l1_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -373,8 +382,13 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
|
||||
write(iout_,*) ' L1 Diagonal solver '
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
+28
-14
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -433,20 +433,22 @@ contains
|
||||
return
|
||||
end subroutine c_gs_solver_free
|
||||
|
||||
subroutine c_gs_solver_descr(sv,info,iout,coarse)
|
||||
subroutine c_gs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_gs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_gs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -455,12 +457,17 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
@@ -526,20 +533,22 @@ contains
|
||||
val = .true.
|
||||
end function c_gs_solver_is_iterative
|
||||
|
||||
subroutine c_bwgs_solver_descr(sv,info,iout,coarse)
|
||||
subroutine c_bwgs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_bwgs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_bwgs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -548,12 +557,17 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
|
||||
@@ -1,125 +0,0 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (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,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -157,7 +157,7 @@ contains
|
||||
return
|
||||
end subroutine c_id_solver_free
|
||||
|
||||
subroutine c_id_solver_descr(sv,info,iout,coarse)
|
||||
subroutine c_id_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -165,12 +165,14 @@ contains
|
||||
class(amg_c_id_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_id_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -178,8 +180,13 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) ' Identity local solver '
|
||||
write(iout_,*) trim(prefix_), ' Identity local solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -234,7 +234,7 @@ contains
|
||||
! Arguments
|
||||
class(amg_c_ilu_solver_type), intent(inout) :: sv
|
||||
|
||||
sv%fact_type = psb_ilu_n_
|
||||
sv%fact_type = amg_ilu_n_
|
||||
sv%fill_in = 0
|
||||
sv%thresh = szero
|
||||
|
||||
@@ -255,13 +255,13 @@ contains
|
||||
info = psb_success_
|
||||
|
||||
call amg_check_def(sv%fact_type,&
|
||||
& 'Factorization',psb_ilu_n_,is_legal_ilu_fact)
|
||||
& 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
|
||||
|
||||
select case(sv%fact_type)
|
||||
case(psb_ilu_n_,psb_milu_n_)
|
||||
case(amg_ilu_n_,amg_milu_n_)
|
||||
call amg_check_def(sv%fill_in,&
|
||||
& 'Level',izero,is_int_non_negative)
|
||||
case(psb_ilu_t_)
|
||||
case(amg_ilu_t_)
|
||||
call amg_check_def(sv%thresh,&
|
||||
& 'Eps',szero,is_legal_s_fact_thrs)
|
||||
end select
|
||||
@@ -406,7 +406,7 @@ contains
|
||||
return
|
||||
end subroutine c_ilu_solver_free
|
||||
|
||||
subroutine c_ilu_solver_descr(sv,info,iout,coarse)
|
||||
subroutine c_ilu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -414,12 +414,14 @@ contains
|
||||
class(amg_c_ilu_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_ilu_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -428,15 +430,20 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) ' Incomplete factorization solver: ',&
|
||||
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
|
||||
& amg_fact_names(sv%fact_type)
|
||||
select case(sv%fact_type)
|
||||
case(psb_ilu_n_,psb_milu_n_)
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
case(psb_ilu_t_)
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill threshold :',sv%thresh
|
||||
case(amg_ilu_n_,amg_milu_n_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
case(amg_ilu_t_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -489,7 +496,7 @@ contains
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = psb_ilu_n_
|
||||
val = amg_ilu_n_
|
||||
end function c_ilu_solver_get_id
|
||||
|
||||
function c_ilu_solver_get_wrksize() result(val)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -39,7 +39,7 @@
|
||||
!
|
||||
! Module: amg_inner_mod
|
||||
!
|
||||
! This module defines the interfaces to inner MLD2P4 routines.
|
||||
! This module defines the interfaces to inner AMG4PSBLAS routines.
|
||||
! The interfaces of the user level routines are defined in amg_prec_mod.f90.
|
||||
!
|
||||
module amg_c_inner_mod
|
||||
@@ -109,11 +109,12 @@ module amg_c_inner_mod
|
||||
end interface amg_map_to_tprol
|
||||
|
||||
abstract interface
|
||||
subroutine amg_caggrmat_var_bld(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
subroutine amg_caggrmat_var_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lpk_, psb_lcspmat_type
|
||||
import :: amg_c_onelev_type, amg_sml_parms
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: dol1smoothing
|
||||
type(psb_cspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
|
||||
@@ -1,11 +1,14 @@
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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
|
||||
@@ -49,10 +52,9 @@ module amg_c_invk_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_c_invk_solver_check
|
||||
procedure, pass(sv) :: clone => amg_c_invk_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_c_invk_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_c_invk_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_c_invk_solver_cseti
|
||||
procedure, pass(sv) :: seti => amg_c_invk_solver_seti
|
||||
generic, public :: set => seti
|
||||
procedure, pass(sv) :: descr => amg_c_invk_solver_descr
|
||||
procedure, pass(sv) :: default => c_invk_solver_default
|
||||
end type amg_c_invk_solver_type
|
||||
@@ -72,6 +74,17 @@ module amg_c_invk_solver
|
||||
end subroutine amg_c_invk_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invk_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& amg_c_base_solver_type, psb_spk_, amg_c_invk_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_c_invk_solver_type), intent(inout) :: sv
|
||||
class(amg_c_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_invk_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
@@ -122,7 +135,7 @@ module amg_c_invk_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invk_solver_descr(sv,info,iout,coarse)
|
||||
subroutine amg_c_invk_solver_descr(sv,info,iout,coarse,prefix)
|
||||
import :: psb_spk_, amg_c_invk_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -132,22 +145,10 @@ module amg_c_invk_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_c_invk_solver_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invk_solver_seti(sv,what,val,info)
|
||||
import :: amg_c_invk_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_c_invk_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_invk_solver_seti
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine c_invk_solver_default(sv)
|
||||
|
||||
@@ -1,11 +1,14 @@
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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
|
||||
@@ -49,12 +52,10 @@ module amg_c_invt_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_c_invt_solver_check
|
||||
procedure, pass(sv) :: clone => amg_c_invt_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_c_invt_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_c_invt_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_c_invt_solver_cseti
|
||||
procedure, pass(sv) :: csetr => amg_c_invt_solver_csetr
|
||||
procedure, pass(sv) :: seti => amg_c_invt_solver_seti
|
||||
procedure, pass(sv) :: setr => amg_c_invt_solver_setr
|
||||
generic, public :: set => seti, setr
|
||||
procedure, pass(sv) :: descr => amg_c_invt_solver_descr
|
||||
procedure, pass(sv) :: default => c_invt_solver_default
|
||||
end type amg_c_invt_solver_type
|
||||
@@ -73,6 +74,17 @@ module amg_c_invt_solver
|
||||
end subroutine amg_c_invt_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invt_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& amg_c_base_solver_type, psb_spk_, amg_c_invt_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_c_invt_solver_type), intent(inout) :: sv
|
||||
class(amg_c_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_invt_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
@@ -134,44 +146,21 @@ module amg_c_invt_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invt_solver_descr(sv,info,iout,coarse)
|
||||
subroutine amg_c_invt_solver_descr(sv,info,iout,coarse,prefix)
|
||||
import :: psb_spk_, amg_c_invt_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_invt_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_c_invt_solver_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invt_solver_setr(sv,what,val,info)
|
||||
import :: amg_c_invt_solver_type, psb_spk_, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_c_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_invt_solver_setr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_invt_solver_seti(sv,what,val,info)
|
||||
import :: amg_c_invt_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_c_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine c_invt_solver_default(sv)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -203,8 +203,8 @@ module amg_c_jac_smoother
|
||||
subroutine amg_c_jac_smoother_clone_settings(sm,smout,info)
|
||||
import :: amg_c_jac_smoother_type, psb_spk_, &
|
||||
& amg_c_base_smoother_type, psb_ipk_
|
||||
class(amg_c_jac_smoother_type), intent(inout) :: sm
|
||||
class(amg_c_base_smoother_type), allocatable, intent(inout) :: smout
|
||||
class(amg_c_jac_smoother_type), intent(inout) :: sm
|
||||
class(amg_c_base_smoother_type), intent(inout) :: smout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_jac_smoother_clone_settings
|
||||
end interface
|
||||
@@ -219,12 +219,13 @@ module amg_c_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse)
|
||||
subroutine amg_c_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
import :: amg_c_jac_smoother_type, psb_ipk_
|
||||
class(amg_c_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_c_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
@@ -313,12 +314,13 @@ module amg_c_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse)
|
||||
subroutine amg_c_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
import :: amg_c_l1_jac_smoother_type, psb_ipk_
|
||||
class(amg_c_l1_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_c_l1_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -0,0 +1,585 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! File: amg_c_jac_solver_mod.f90
|
||||
!
|
||||
! Module: amg_c_jac_solver_mod
|
||||
!
|
||||
! This module defines:
|
||||
! - the amg_c_jac_solver_type data structure containing the ingredients
|
||||
! for a local Jacobi iteration. The iterations are local to a process
|
||||
! (they operate on the block diagonal).
|
||||
!
|
||||
!
|
||||
module amg_c_jac_solver
|
||||
|
||||
use amg_c_base_solver_mod
|
||||
|
||||
type, extends(amg_c_base_solver_type) :: amg_c_jac_solver_type
|
||||
type(psb_cspmat_type) :: a
|
||||
type(psb_c_vect_type), allocatable :: dv
|
||||
complex(psb_spk_), allocatable :: d(:)
|
||||
integer(psb_ipk_) :: sweeps
|
||||
real(psb_spk_) :: eps
|
||||
contains
|
||||
procedure, pass(sv) :: dump => amg_c_jac_solver_dmp
|
||||
procedure, pass(sv) :: check => c_jac_solver_check
|
||||
procedure, pass(sv) :: clone => amg_c_jac_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_c_jac_solver_clone_settings
|
||||
procedure, pass(sv) :: clear_data => amg_c_jac_solver_clear_data
|
||||
procedure, pass(sv) :: build => amg_c_jac_solver_bld
|
||||
procedure, pass(sv) :: cnv => amg_c_jac_solver_cnv
|
||||
procedure, pass(sv) :: apply_v => amg_c_jac_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => amg_c_jac_solver_apply
|
||||
procedure, pass(sv) :: free => c_jac_solver_free
|
||||
procedure, pass(sv) :: cseti => c_jac_solver_cseti
|
||||
procedure, pass(sv) :: csetc => c_jac_solver_csetc
|
||||
procedure, pass(sv) :: csetr => c_jac_solver_csetr
|
||||
procedure, pass(sv) :: descr => c_jac_solver_descr
|
||||
procedure, pass(sv) :: default => c_jac_solver_default
|
||||
procedure, pass(sv) :: sizeof => c_jac_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => c_jac_solver_get_nzeros
|
||||
procedure, nopass :: get_wrksz => c_jac_solver_get_wrksize
|
||||
procedure, nopass :: get_fmt => c_jac_solver_get_fmt
|
||||
procedure, nopass :: get_id => c_jac_solver_get_id
|
||||
procedure, nopass :: is_iterative => c_jac_solver_is_iterative
|
||||
end type amg_c_jac_solver_type
|
||||
|
||||
type, extends(amg_c_jac_solver_type) :: amg_c_l1_jac_solver_type
|
||||
contains
|
||||
procedure, pass(sv) :: build => amg_c_l1_jac_solver_bld
|
||||
procedure, pass(sv) :: descr => c_l1_jac_solver_descr
|
||||
procedure, nopass :: get_fmt => c_l1_jac_solver_get_fmt
|
||||
procedure, nopass :: get_id => c_l1_jac_solver_get_id
|
||||
end type amg_c_l1_jac_solver_type
|
||||
|
||||
|
||||
private :: c_jac_solver_bld, c_jac_solver_apply, &
|
||||
& c_jac_solver_free, &
|
||||
& c_jac_solver_descr, c_jac_solver_sizeof, &
|
||||
& c_jac_solver_default, c_jac_solver_dmp, &
|
||||
& c_jac_solver_apply_vect, c_jac_solver_get_nzeros, &
|
||||
& c_jac_solver_get_fmt, c_jac_solver_check,&
|
||||
& c_jac_solver_is_iterative, &
|
||||
& c_jac_solver_get_id, c_jac_solver_get_wrksize
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_jac_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_jac_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
|
||||
import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_jac_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_jac_solver_apply
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_jac_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_jac_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_c_l1_jac_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_l1_jac_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_l1_jac_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_solver_cnv(sv,info,amold,vmold,imold)
|
||||
import :: amg_c_jac_solver_type, psb_spk_, &
|
||||
& psb_c_base_sparse_mat, psb_c_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
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_jac_solver_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
|
||||
import :: psb_desc_type, amg_c_jac_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, &
|
||||
& psb_ipk_
|
||||
implicit none
|
||||
class(amg_c_jac_solver_type), intent(in) :: sv
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix, head
|
||||
logical, optional, intent(in) :: solver, global_num
|
||||
end subroutine amg_c_jac_solver_dmp
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_solver_clone(sv,svout,info)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
& amg_c_base_solver_type, amg_c_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_jac_solver_clone
|
||||
end interface
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine amg_c_l1_jac_solver_clone(sv,svout,info)
|
||||
!!$ import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
!!$ & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
!!$ & amg_c_base_solver_type, amg_c_l1_jac_solver_type, psb_ipk_
|
||||
!!$ Implicit None
|
||||
!!$
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_c_l1_jac_solver_type), intent(inout) :: sv
|
||||
!!$ class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_c_l1_jac_solver_clone
|
||||
!!$ end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
& amg_c_base_solver_type, amg_c_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
class(amg_c_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_jac_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_jac_solver_clear_data(sv,info)
|
||||
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
|
||||
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
|
||||
& amg_c_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_jac_solver_clear_data
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine c_jac_solver_default(sv)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
|
||||
sv%sweeps = ione
|
||||
sv%eps = dzero
|
||||
|
||||
return
|
||||
end subroutine c_jac_solver_default
|
||||
|
||||
subroutine c_jac_solver_check(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_jac_solver_check'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
call amg_check_def(sv%sweeps,&
|
||||
& 'Jacobi sweeps',ione,is_int_positive)
|
||||
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine c_jac_solver_check
|
||||
|
||||
subroutine c_jac_solver_cseti(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_jac_solver_cseti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('SOLVER_SWEEPS')
|
||||
sv%sweeps = val
|
||||
case default
|
||||
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_jac_solver_cseti
|
||||
|
||||
subroutine c_jac_solver_csetc(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='c_jac_solver_csetc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_jac_solver_csetc
|
||||
|
||||
subroutine c_jac_solver_csetr(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_jac_solver_csetr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('SOLVER_EPS')
|
||||
sv%eps = val
|
||||
case default
|
||||
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
|
||||
end select
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_jac_solver_csetr
|
||||
|
||||
subroutine c_jac_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_jac_solver_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
call sv%a%free()
|
||||
if (allocated(sv%dv)) then
|
||||
call sv%dv%free(info)
|
||||
deallocate(sv%dv)
|
||||
end if
|
||||
if (allocated(sv%d)) deallocate(sv%d)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_jac_solver_free
|
||||
|
||||
subroutine c_jac_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_jac_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
iout_ = iout
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_jac_solver_descr
|
||||
|
||||
function c_jac_solver_get_nzeros(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = 0
|
||||
val = val + sv%a%get_nzeros()
|
||||
val = val + sv%dv%get_nrows()
|
||||
|
||||
return
|
||||
end function c_jac_solver_get_nzeros
|
||||
|
||||
function c_jac_solver_sizeof(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_c_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = psb_sizeof_ip
|
||||
val = val + sv%a%sizeof()
|
||||
val = val + sv%dv%sizeof()
|
||||
|
||||
return
|
||||
end function c_jac_solver_sizeof
|
||||
|
||||
function c_jac_solver_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Jacobi solver"
|
||||
end function c_jac_solver_get_fmt
|
||||
|
||||
function c_jac_solver_get_id() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_jac_
|
||||
end function c_jac_solver_get_id
|
||||
|
||||
!
|
||||
! If this is true, then the solver needs a starting
|
||||
! guess. Currently only handled in JAC smoother.
|
||||
!
|
||||
function c_jac_solver_is_iterative() result(val)
|
||||
implicit none
|
||||
logical :: val
|
||||
|
||||
val = .true.
|
||||
end function c_jac_solver_is_iterative
|
||||
|
||||
function c_jac_solver_get_wrksize() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = 2
|
||||
end function c_jac_solver_get_wrksize
|
||||
|
||||
subroutine c_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_l1_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_l1_jac_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
iout_ = iout
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_l1_jac_solver_descr
|
||||
|
||||
function c_l1_jac_solver_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "L1-Jacobi solver"
|
||||
end function c_l1_jac_solver_get_fmt
|
||||
|
||||
function c_l1_jac_solver_get_id() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_l1_jac_
|
||||
end function c_l1_jac_solver_get_id
|
||||
|
||||
end module amg_c_jac_solver
|
||||
@@ -1,11 +1,14 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
@@ -52,14 +55,14 @@
|
||||
! 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 MLD2P4 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
|
||||
! 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 MLD2P4 GROUP OR ITS CONTRIBUTORS
|
||||
! 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
|
||||
@@ -70,16 +73,16 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
! File: amg_c_rkr_solver_mod.f90
|
||||
! File: amg_c_krm_solver_mod.f90
|
||||
!
|
||||
! Module: amg_c_rkr_solver_mod
|
||||
! Module: amg_c_krm_solver_mod
|
||||
!
|
||||
module amg_c_rkr_solver
|
||||
module amg_c_krm_solver
|
||||
|
||||
use amg_c_base_solver_mod
|
||||
use amg_c_prec_type
|
||||
|
||||
type, extends(amg_c_base_solver_type) :: amg_c_rkr_solver_type
|
||||
type, extends(amg_c_base_solver_type) :: amg_c_krm_solver_type
|
||||
!
|
||||
logical :: global
|
||||
character(len=16) :: method, kprec, sub_solve
|
||||
@@ -94,46 +97,46 @@ module amg_c_rkr_solver
|
||||
contains
|
||||
!
|
||||
!
|
||||
procedure, pass(sv) :: dump => c_rkr_solver_dmp
|
||||
procedure, pass(sv) :: check => c_rkr_solver_check
|
||||
procedure, pass(sv) :: clone => c_rkr_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => c_rkr_solver_clone_settings
|
||||
procedure, pass(sv) :: cnv => c_rkr_solver_cnv
|
||||
procedure, pass(sv) :: apply_v => amg_c_rkr_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => amg_c_rkr_solver_apply
|
||||
procedure, pass(sv) :: clear_data => c_rkr_solver_clear_data
|
||||
procedure, pass(sv) :: free => c_rkr_solver_free
|
||||
procedure, pass(sv) :: cseti => c_rkr_solver_cseti
|
||||
procedure, pass(sv) :: csetc => c_rkr_solver_csetc
|
||||
procedure, pass(sv) :: csetr => c_rkr_solver_csetr
|
||||
procedure, pass(sv) :: sizeof => c_rkr_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => c_rkr_solver_get_nzeros
|
||||
!procedure, nopass :: get_id => c_rkr_solver_get_id
|
||||
procedure, pass(sv) :: is_global => c_rkr_solver_is_global
|
||||
procedure, nopass :: is_iterative => c_rkr_solver_is_iterative
|
||||
procedure, pass(sv) :: dump => c_krm_solver_dmp
|
||||
procedure, pass(sv) :: check => c_krm_solver_check
|
||||
procedure, pass(sv) :: clone => c_krm_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => c_krm_solver_clone_settings
|
||||
procedure, pass(sv) :: cnv => c_krm_solver_cnv
|
||||
procedure, pass(sv) :: apply_v => amg_c_krm_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => amg_c_krm_solver_apply
|
||||
procedure, pass(sv) :: clear_data => c_krm_solver_clear_data
|
||||
procedure, pass(sv) :: free => c_krm_solver_free
|
||||
procedure, pass(sv) :: cseti => c_krm_solver_cseti
|
||||
procedure, pass(sv) :: csetc => c_krm_solver_csetc
|
||||
procedure, pass(sv) :: csetr => c_krm_solver_csetr
|
||||
procedure, pass(sv) :: sizeof => c_krm_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => c_krm_solver_get_nzeros
|
||||
!procedure, nopass :: get_id => c_krm_solver_get_id
|
||||
procedure, pass(sv) :: is_global => c_krm_solver_is_global
|
||||
procedure, nopass :: is_iterative => c_krm_solver_is_iterative
|
||||
|
||||
|
||||
!
|
||||
! These methods are specific for the new solver type
|
||||
! and therefore need to be overridden
|
||||
!
|
||||
procedure, pass(sv) :: descr => c_rkr_solver_descr
|
||||
procedure, pass(sv) :: default => c_rkr_solver_default
|
||||
procedure, pass(sv) :: build => amg_c_rkr_solver_bld
|
||||
procedure, nopass :: get_fmt => c_rkr_solver_get_fmt
|
||||
end type amg_c_rkr_solver_type
|
||||
procedure, pass(sv) :: descr => c_krm_solver_descr
|
||||
procedure, pass(sv) :: default => c_krm_solver_default
|
||||
procedure, pass(sv) :: build => amg_c_krm_solver_bld
|
||||
procedure, nopass :: get_fmt => c_krm_solver_get_fmt
|
||||
end type amg_c_krm_solver_type
|
||||
|
||||
|
||||
private :: c_rkr_solver_get_fmt, c_rkr_solver_descr, c_rkr_solver_default
|
||||
private :: c_krm_solver_get_fmt, c_krm_solver_descr, c_krm_solver_default
|
||||
|
||||
interface
|
||||
subroutine amg_c_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
subroutine amg_c_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
import :: psb_desc_type, amg_c_rkr_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
import :: psb_desc_type, amg_c_krm_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_c_krm_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
|
||||
@@ -143,17 +146,17 @@ module amg_c_rkr_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_c_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_c_rkr_solver_apply_vect
|
||||
end subroutine amg_c_krm_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
subroutine amg_c_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
import :: psb_desc_type, amg_c_rkr_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
import :: psb_desc_type, amg_c_krm_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
complex(psb_spk_),intent(inout) :: x(:)
|
||||
complex(psb_spk_),intent(inout) :: y(:)
|
||||
complex(psb_spk_),intent(in) :: alpha,beta
|
||||
@@ -162,24 +165,24 @@ module amg_c_rkr_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
complex(psb_spk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_c_rkr_solver_apply
|
||||
end subroutine amg_c_krm_solver_apply
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_c_rkr_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
subroutine amg_c_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_c_krm_solver_type, psb_c_vect_type, psb_spk_, &
|
||||
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_cspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_c_krm_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_rkr_solver_bld
|
||||
end subroutine amg_c_krm_solver_bld
|
||||
end interface
|
||||
|
||||
|
||||
@@ -187,12 +190,12 @@ contains
|
||||
|
||||
!
|
||||
!
|
||||
subroutine c_rkr_solver_default(sv)
|
||||
subroutine c_krm_solver_default(sv)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
|
||||
sv%method = 'bicgstab'
|
||||
sv%kprec = 'bjac'
|
||||
@@ -207,42 +210,42 @@ contains
|
||||
sv%global = .false.
|
||||
|
||||
return
|
||||
end subroutine c_rkr_solver_default
|
||||
end subroutine c_krm_solver_default
|
||||
|
||||
function c_rkr_solver_get_nzeros(sv) result(val)
|
||||
function c_krm_solver_get_nzeros(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_c_rkr_solver_type), intent(in) :: sv
|
||||
class(amg_c_krm_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = sv%prec%get_nzeros()
|
||||
|
||||
return
|
||||
end function c_rkr_solver_get_nzeros
|
||||
end function c_krm_solver_get_nzeros
|
||||
|
||||
function c_rkr_solver_sizeof(sv) result(val)
|
||||
function c_krm_solver_sizeof(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_c_rkr_solver_type), intent(in) :: sv
|
||||
class(amg_c_krm_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = sv%prec%sizeof() + sv%desc_local%sizeof() + sv%a_local%sizeof()
|
||||
|
||||
return
|
||||
end function c_rkr_solver_sizeof
|
||||
end function c_krm_solver_sizeof
|
||||
|
||||
|
||||
subroutine c_rkr_solver_check(sv,info)
|
||||
subroutine c_krm_solver_check(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_rkr_solver_check'
|
||||
character(len=20) :: name='c_krm_solver_check'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -256,36 +259,36 @@ contains
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine c_rkr_solver_check
|
||||
end subroutine c_krm_solver_check
|
||||
|
||||
subroutine c_rkr_solver_cseti(sv,what,val,info,idx)
|
||||
subroutine c_krm_solver_cseti(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_rkr_solver_cseti'
|
||||
character(len=20) :: name='c_krm_solver_cseti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('RKR_IRST')
|
||||
case('KRM_IRST')
|
||||
sv%irst = val
|
||||
case('RKR_ISTOPC')
|
||||
case('KRM_ISTOPC')
|
||||
sv%istopc = val
|
||||
case('RKR_ITMAX')
|
||||
case('KRM_ITMAX')
|
||||
sv%itmax = val
|
||||
case('RKR_ITRACE')
|
||||
case('KRM_ITRACE')
|
||||
sv%itrace = val
|
||||
case('RKR_SUB_SOLVE')
|
||||
case('KRM_SUB_SOLVE')
|
||||
sv%i_sub_solve = val
|
||||
case('RKR_FILLIN')
|
||||
case('KRM_FILLIN')
|
||||
sv%fillin = val
|
||||
case default
|
||||
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
|
||||
@@ -296,33 +299,33 @@ contains
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_rkr_solver_cseti
|
||||
end subroutine c_krm_solver_cseti
|
||||
|
||||
subroutine c_rkr_solver_csetc(sv,what,val,info,idx)
|
||||
subroutine c_krm_solver_csetc(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='c_rkr_solver_csetc'
|
||||
character(len=20) :: name='c_krm_solver_csetc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('RKR_METHOD')
|
||||
case('KRM_METHOD')
|
||||
sv%method = psb_toupper(trim(val))
|
||||
case('RKR_KPREC')
|
||||
case('KRM_KPREC')
|
||||
sv%kprec = psb_toupper(trim(val))
|
||||
case('RKR_SUB_SOLVE')
|
||||
case('KRM_SUB_SOLVE')
|
||||
sv%sub_solve = psb_toupper(trim(val))
|
||||
case('RKR_GLOBAL')
|
||||
case('KRM_GLOBAL')
|
||||
select case(psb_toupper(trim(val)))
|
||||
case('LOCAL','FALSE')
|
||||
sv%global = .false.
|
||||
@@ -345,26 +348,26 @@ contains
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_rkr_solver_csetc
|
||||
end subroutine c_krm_solver_csetc
|
||||
|
||||
subroutine c_rkr_solver_csetr(sv,what,val,info,idx)
|
||||
subroutine c_krm_solver_csetr(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_rkr_solver_csetr'
|
||||
character(len=20) :: name='c_krm_solver_csetr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('RKR_EPS')
|
||||
case('KRM_EPS')
|
||||
sv%eps = val
|
||||
case default
|
||||
call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
|
||||
@@ -375,18 +378,18 @@ contains
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_rkr_solver_csetr
|
||||
end subroutine c_krm_solver_csetr
|
||||
|
||||
subroutine c_rkr_solver_clear_data(sv,info)
|
||||
subroutine c_krm_solver_clear_data(sv,info)
|
||||
use psb_base_mod, only : psb_exit
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
type(psb_ctxt_type) :: l_ctxt
|
||||
character(len=20) :: name='c_rkr_solver_free'
|
||||
character(len=20) :: name='c_krm_solver_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -403,19 +406,19 @@ contains
|
||||
nullify(sv%a)
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
end subroutine c_rkr_solver_clear_data
|
||||
end subroutine c_krm_solver_clear_data
|
||||
|
||||
|
||||
subroutine c_rkr_solver_free(sv,info)
|
||||
subroutine c_krm_solver_free(sv,info)
|
||||
use psb_base_mod, only : psb_exit
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
type(psb_ctxt_type) :: l_ctxt
|
||||
character(len=20) :: name='c_rkr_solver_free'
|
||||
character(len=20) :: name='c_krm_solver_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -424,29 +427,31 @@ contains
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
end subroutine c_rkr_solver_free
|
||||
end subroutine c_krm_solver_free
|
||||
|
||||
function c_rkr_solver_get_fmt() result(val)
|
||||
function c_krm_solver_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "RKR solver"
|
||||
end function c_rkr_solver_get_fmt
|
||||
val = "KRM solver"
|
||||
end function c_krm_solver_get_fmt
|
||||
|
||||
subroutine c_rkr_solver_descr(sv,info,iout,coarse)
|
||||
subroutine c_krm_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_rkr_solver_type), intent(in) :: sv
|
||||
class(amg_c_krm_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_c_rkr_solver_descr'
|
||||
character(len=20), parameter :: name='amg_c_krm_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -455,34 +460,33 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%global) then
|
||||
write(iout_,*) ' Recursive Krylov solver (global)'
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
|
||||
else
|
||||
write(iout_,*) ' Recursive Krylov solver (local) '
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
|
||||
end if
|
||||
write(iout_,*) ' method: ',sv%method
|
||||
write(iout_,*) ' kprec: ',sv%kprec
|
||||
if (sv%i_sub_solve > 0) then
|
||||
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
|
||||
else
|
||||
write(iout_,*) ' sub_solve: ',sv%sub_solve
|
||||
end if
|
||||
write(iout_,*) ' itmax: ',sv%itmax
|
||||
write(iout_,*) ' eps: ',sv%eps
|
||||
write(iout_,*) ' fillin: ',sv%fillin
|
||||
|
||||
write(iout_,*) trim(prefix_), ' method: ',sv%method
|
||||
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
|
||||
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
|
||||
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
|
||||
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine c_rkr_solver_descr
|
||||
end subroutine c_krm_solver_descr
|
||||
|
||||
subroutine c_rkr_solver_cnv(sv,info,amold,vmold,imold)
|
||||
subroutine c_krm_solver_cnv(sv,info,amold,vmold,imold)
|
||||
implicit none
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_c_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
@@ -490,13 +494,13 @@ contains
|
||||
|
||||
call sv%prec%cnv(info,amold=amold,vmold=vmold,imold=imold)
|
||||
|
||||
end subroutine c_rkr_solver_cnv
|
||||
end subroutine c_krm_solver_cnv
|
||||
|
||||
subroutine c_rkr_solver_clone(sv,svout,info)
|
||||
subroutine c_krm_solver_clone(sv,svout,info)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -505,7 +509,7 @@ contains
|
||||
call svout%free(info)
|
||||
allocate(svout,stat=info,mold=sv)
|
||||
select type(so=>svout)
|
||||
class is(amg_c_rkr_solver_type)
|
||||
class is(amg_c_krm_solver_type)
|
||||
so%method = sv%method
|
||||
so%kprec = sv%kprec
|
||||
so%sub_solve = sv%sub_solve
|
||||
@@ -524,21 +528,21 @@ contains
|
||||
info = psb_err_internal_error_
|
||||
end select
|
||||
|
||||
end subroutine c_rkr_solver_clone
|
||||
end subroutine c_krm_solver_clone
|
||||
|
||||
|
||||
subroutine c_rkr_solver_clone_settings(sv,svout,info)
|
||||
subroutine c_krm_solver_clone_settings(sv,svout,info)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_c_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_c_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select type(so=>svout)
|
||||
class is(amg_c_rkr_solver_type)
|
||||
class is(amg_c_krm_solver_type)
|
||||
so%method = sv%method
|
||||
so%kprec = sv%kprec
|
||||
so%sub_solve = sv%sub_solve
|
||||
@@ -554,11 +558,11 @@ contains
|
||||
info = psb_err_internal_error_
|
||||
end select
|
||||
|
||||
end subroutine c_rkr_solver_clone_settings
|
||||
end subroutine c_krm_solver_clone_settings
|
||||
|
||||
subroutine c_rkr_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
|
||||
subroutine c_krm_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
|
||||
implicit none
|
||||
class(amg_c_rkr_solver_type), intent(in) :: sv
|
||||
class(amg_c_krm_solver_type), intent(in) :: sv
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -568,23 +572,23 @@ contains
|
||||
|
||||
call sv%prec%dump(info,prefix=prefix,head=head)
|
||||
|
||||
end subroutine c_rkr_solver_dmp
|
||||
end subroutine c_krm_solver_dmp
|
||||
!
|
||||
! Notify whether RKR is used as a global solver
|
||||
! Notify whether KRM is used as a global solver
|
||||
!
|
||||
function c_rkr_solver_is_global(sv) result(val)
|
||||
function c_krm_solver_is_global(sv) result(val)
|
||||
implicit none
|
||||
class(amg_c_rkr_solver_type), intent(in) :: sv
|
||||
class(amg_c_krm_solver_type), intent(in) :: sv
|
||||
logical :: val
|
||||
|
||||
val = (sv%global)
|
||||
end function c_rkr_solver_is_global
|
||||
end function c_krm_solver_is_global
|
||||
!
|
||||
function c_rkr_solver_is_iterative() result(val)
|
||||
function c_krm_solver_is_iterative() result(val)
|
||||
implicit none
|
||||
logical :: val
|
||||
|
||||
val = .true.
|
||||
end function c_rkr_solver_is_iterative
|
||||
end function c_krm_solver_is_iterative
|
||||
|
||||
end module amg_c_rkr_solver
|
||||
end module amg_c_krm_solver
|
||||
@@ -3,9 +3,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -78,7 +78,8 @@ module amg_c_mumps_solver
|
||||
!
|
||||
! Controls to be set before MUMPS instantiation:
|
||||
!
|
||||
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: LOCAL 1==amg_global_solver_: GLOBAL
|
||||
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: 'LOCAL_SOLVER
|
||||
! 1==amg_global_solver_: 'GLOBAL_SOLVER'
|
||||
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
|
||||
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
|
||||
integer(psb_ipk_), dimension(3) :: ipar
|
||||
@@ -313,22 +314,24 @@ subroutine c_mumps_solver_finalize(sv)
|
||||
|
||||
end subroutine c_mumps_solver_finalize
|
||||
|
||||
subroutine c_mumps_solver_descr(sv,info,iout,coarse)
|
||||
subroutine c_mumps_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_mumps_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: me, np
|
||||
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -337,8 +340,13 @@ subroutine c_mumps_solver_descr(sv,info,iout,coarse)
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) ' MUMPS Solver. '
|
||||
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
+335
-164
@@ -1,15 +1,15 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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:
|
||||
@@ -21,7 +21,7 @@
|
||||
! 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
|
||||
@@ -33,22 +33,22 @@
|
||||
! 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.
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! File: amg_c_onelev_mod.f90
|
||||
!
|
||||
! Module: amg_c_onelev_mod
|
||||
!
|
||||
! This module defines:
|
||||
! This module defines:
|
||||
! - the amg_c_onelev_type data structure containing one level
|
||||
! of a multilevel preconditioner and related
|
||||
! data structures;
|
||||
!
|
||||
! It contains routines for
|
||||
! - Building and applying;
|
||||
! - Building and applying;
|
||||
! - checking if the preconditioner is correctly defined;
|
||||
! - printing a description of the preconditioner;
|
||||
! - deallocating the preconditioner data structure.
|
||||
! - deallocating the preconditioner data structure.
|
||||
!
|
||||
|
||||
module amg_c_onelev_mod
|
||||
@@ -56,6 +56,7 @@ module amg_c_onelev_mod
|
||||
use amg_base_prec_type
|
||||
use amg_c_base_smoother_mod
|
||||
use amg_c_dec_aggregator_mod
|
||||
|
||||
use psb_base_mod, only : psb_cspmat_type, psb_c_vect_type, &
|
||||
& psb_c_base_vect_type, psb_lcspmat_type, psb_clinmap_type, psb_spk_, &
|
||||
& psb_ipk_, psb_epk_, psb_lpk_, psb_desc_type, psb_i_base_vect_type, &
|
||||
@@ -73,16 +74,16 @@ module amg_c_onelev_mod
|
||||
! class(amg_c_base_smoother_type), pointer :: sm2 => null()
|
||||
! class(amg_cmlprec_wrk_type), allocatable :: wrk
|
||||
! class(amg_c_base_aggregator_type), allocatable :: aggr
|
||||
! type(amg_sml_parms) :: parms
|
||||
! type(amg_sml_parms) :: parms
|
||||
! type(psb_cspmat_type) :: ac
|
||||
! type(psb_cesc_type) :: desc_ac
|
||||
! type(psb_cspmat_type), pointer :: base_a => null()
|
||||
! type(psb_desc_type), pointer :: base_desc => null()
|
||||
! type(psb_cspmat_type), pointer :: base_a => null()
|
||||
! type(psb_desc_type), pointer :: base_desc => null()
|
||||
! type(psb_clinmap_type) :: map
|
||||
! end type amg_conelev_type
|
||||
!
|
||||
! Note that s denotes the kind of the real data type to be chosen
|
||||
! according to single/double precision version of MLD2P4.
|
||||
! according to single/double precision version of AMG4PSBLAS.
|
||||
!
|
||||
! sm,sm2a - class(amg_c_base_smoother_type), allocatable
|
||||
! The current level pre- and post-smooother.
|
||||
@@ -93,7 +94,7 @@ module amg_c_onelev_mod
|
||||
! Workspace for application of preconditioner; may be
|
||||
! pre-allocated to save time in the application within a
|
||||
! Krylov solver.
|
||||
! aggr - class(amg_c_base_aggregator_type), allocatable
|
||||
! aggr - class(amg_c_base_aggregator_type), allocatable
|
||||
! The aggregator object: holds the algorithmic choices and
|
||||
! (possibly) additional data for building the aggregation.
|
||||
! parms - type(amg_sml_parms)
|
||||
@@ -104,7 +105,7 @@ module amg_c_onelev_mod
|
||||
! The communication descriptor associated to the matrix
|
||||
! stored in ac.
|
||||
! base_a - type(psb_cspmat_type), pointer.
|
||||
! Pointer (really a pointer!) to the local part of the current
|
||||
! 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.
|
||||
@@ -115,13 +116,13 @@ module amg_c_onelev_mod
|
||||
! vector spaces associated to the index spaces of the previous
|
||||
! and current levels.
|
||||
!
|
||||
! Methods:
|
||||
! 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.
|
||||
! then calls the descr() method of the smoother object.
|
||||
!
|
||||
! descr - Prints a description of the object.
|
||||
! default - Set default values
|
||||
@@ -130,14 +131,14 @@ module amg_c_onelev_mod
|
||||
! it is passed to the smoother object for further processing.
|
||||
! check - Sanity checks.
|
||||
! sizeof - Total memory occupation in bytes
|
||||
! get_nzeros - Number of nonzeros
|
||||
! get_nzeros - Number of nonzeros
|
||||
! get_wrksz - How many workspace vector does apply_vect need
|
||||
! allocate_wrk - Allocate auxiliary workspace
|
||||
! free_wrk - Free auxiliary workspace
|
||||
! bld_tprol - Invoke the aggr method to build the tentative prolongator
|
||||
! mat_asb - Build the final (possibly smoothed) prolongator and coarse matrix.
|
||||
! mat_asb - Build the final (possibly smoothed) prolongator and coarse matrix.
|
||||
!
|
||||
!
|
||||
!
|
||||
type amg_cmlprec_wrk_type
|
||||
complex(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
|
||||
type(psb_c_vect_type) :: vtx, vty, vx2l, vy2l
|
||||
@@ -148,25 +149,35 @@ module amg_c_onelev_mod
|
||||
procedure, pass(wk) :: clone => c_wrk_clone
|
||||
procedure, pass(wk) :: move_alloc => c_wrk_move_alloc
|
||||
procedure, pass(wk) :: cnv => c_wrk_cnv
|
||||
procedure, pass(wk) :: sizeof => c_wrk_sizeof
|
||||
procedure, pass(wk) :: sizeof => c_wrk_sizeof
|
||||
end type amg_cmlprec_wrk_type
|
||||
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
|
||||
|
||||
type amg_c_remap_data_type
|
||||
type(psb_cspmat_type) :: ac_pre_remap
|
||||
type(psb_desc_type) :: desc_ac_pre_remap
|
||||
integer(psb_ipk_) :: idest
|
||||
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
|
||||
contains
|
||||
procedure, pass(rmp) :: clone => c_remap_data_clone
|
||||
end type amg_c_remap_data_type
|
||||
|
||||
type amg_c_onelev_type
|
||||
class(amg_c_base_smoother_type), allocatable :: sm, sm2a
|
||||
class(amg_c_base_smoother_type), pointer :: sm2 => null()
|
||||
class(amg_cmlprec_wrk_type), allocatable :: wrk
|
||||
class(amg_c_base_aggregator_type), allocatable :: aggr
|
||||
type(amg_sml_parms) :: parms
|
||||
type(amg_sml_parms) :: parms
|
||||
type(psb_cspmat_type) :: ac
|
||||
integer(psb_ipk_) :: ac_nz_loc
|
||||
integer(psb_lpk_) :: ac_nz_tot
|
||||
type(psb_desc_type) :: desc_ac
|
||||
type(psb_cspmat_type), pointer :: base_a => null()
|
||||
type(psb_desc_type), pointer :: base_desc => null()
|
||||
type(psb_cspmat_type), pointer :: base_a => null()
|
||||
type(psb_desc_type), pointer :: base_desc => null()
|
||||
type(psb_lcspmat_type) :: tprol
|
||||
type(psb_clinmap_type) :: map
|
||||
type(psb_clinmap_type) :: linmap
|
||||
type(amg_c_remap_data_type) :: remap_data
|
||||
real(psb_spk_) :: szratio
|
||||
contains
|
||||
procedure, pass(lv) :: bld_tprol => c_base_onelev_bld_tprol
|
||||
@@ -176,8 +187,10 @@ module amg_c_onelev_mod
|
||||
procedure, pass(lv) :: clone => c_base_onelev_clone
|
||||
procedure, pass(lv) :: cnv => amg_c_base_onelev_cnv
|
||||
procedure, pass(lv) :: descr => amg_c_base_onelev_descr
|
||||
procedure, pass(lv) :: memory_use => amg_c_base_onelev_memory_use
|
||||
procedure, pass(lv) :: default => c_base_onelev_default
|
||||
procedure, pass(lv) :: free => amg_c_base_onelev_free
|
||||
procedure, pass(lv) :: free_smoothers => amg_c_base_onelev_free_smoothers
|
||||
procedure, pass(lv) :: nullify => c_base_onelev_nullify
|
||||
procedure, pass(lv) :: check => amg_c_base_onelev_check
|
||||
procedure, pass(lv) :: dump => amg_c_base_onelev_dump
|
||||
@@ -187,7 +200,7 @@ module amg_c_onelev_mod
|
||||
procedure, pass(lv) :: setsm => amg_c_base_onelev_setsm
|
||||
procedure, pass(lv) :: setsv => amg_c_base_onelev_setsv
|
||||
procedure, pass(lv) :: setag => amg_c_base_onelev_setag
|
||||
generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag
|
||||
generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag
|
||||
procedure, pass(lv) :: sizeof => c_base_onelev_sizeof
|
||||
procedure, pass(lv) :: get_nzeros => c_base_onelev_get_nzeros
|
||||
procedure, pass(lv) :: get_wrksz => c_base_onelev_get_wrksize
|
||||
@@ -195,7 +208,14 @@ module amg_c_onelev_mod
|
||||
procedure, pass(lv) :: free_wrk => c_base_onelev_free_wrk
|
||||
procedure, nopass :: stringval => amg_stringval
|
||||
procedure, pass(lv) :: move_alloc => c_base_onelev_move_alloc
|
||||
|
||||
|
||||
|
||||
procedure, pass(lv) :: map_rstr_a => amg_c_base_onelev_map_rstr_a
|
||||
procedure, pass(lv) :: map_prol_a => amg_c_base_onelev_map_prol_a
|
||||
procedure, pass(lv) :: map_rstr_v => amg_c_base_onelev_map_rstr_v
|
||||
procedure, pass(lv) :: map_prol_v => amg_c_base_onelev_map_prol_v
|
||||
generic, public :: map_rstr => map_rstr_a, map_rstr_v
|
||||
generic, public :: map_prol => map_prol_a, map_prol_v
|
||||
end type amg_c_onelev_type
|
||||
|
||||
type amg_c_onelev_node
|
||||
@@ -209,11 +229,11 @@ module amg_c_onelev_mod
|
||||
& c_base_onelev_get_wrksize, c_base_onelev_allocate_wrk, &
|
||||
& c_base_onelev_free_wrk
|
||||
|
||||
interface
|
||||
interface
|
||||
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
|
||||
type(psb_cspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
@@ -238,141 +258,172 @@ module amg_c_onelev_mod
|
||||
end subroutine amg_c_base_onelev_build
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout)
|
||||
interface
|
||||
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
|
||||
! Arguments
|
||||
class(amg_c_onelev_type), intent(in) :: lv
|
||||
integer(psb_ipk_), intent(in) :: il,nl,ilmin
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
class(amg_c_onelev_type), intent(in) :: lv
|
||||
integer(psb_ipk_), intent(in) :: il,nl,ilmin
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_c_base_onelev_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
interface
|
||||
subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
|
||||
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
|
||||
! Arguments
|
||||
class(amg_c_onelev_type), intent(in) :: lv
|
||||
integer(psb_ipk_), intent(in) :: il,nl,ilmin
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: global
|
||||
end subroutine amg_c_base_onelev_memory_use
|
||||
end interface
|
||||
|
||||
interface
|
||||
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
|
||||
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_base_onelev_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_base_onelev_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
class(amg_c_onelev_type), intent(inout) :: lv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_base_onelev_free_smoothers
|
||||
end interface
|
||||
|
||||
interface
|
||||
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
|
||||
! Arguments
|
||||
class(amg_c_onelev_type), intent(inout) :: lv
|
||||
class(amg_c_onelev_type), intent(inout) :: lv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_c_base_onelev_check
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
|
||||
! 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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
end subroutine amg_c_base_onelev_setsm
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
|
||||
! 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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
end subroutine amg_c_base_onelev_setsv
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
|
||||
! 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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
end subroutine amg_c_base_onelev_setag
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
|
||||
! Arguments
|
||||
class(amg_c_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
class(amg_c_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_c_base_onelev_cseti
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
! Arguments
|
||||
class(amg_c_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
class(amg_c_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_c_base_onelev_csetc
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
class(amg_c_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
|
||||
class(amg_c_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
@@ -380,13 +431,13 @@ interface
|
||||
end subroutine amg_c_base_onelev_csetr
|
||||
end interface
|
||||
|
||||
interface
|
||||
interface
|
||||
subroutine amg_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
|
||||
& 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
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -394,15 +445,62 @@ interface
|
||||
logical, optional, intent(in) :: ac, rp, smoother, solver, tprol, global_num
|
||||
end subroutine amg_c_base_onelev_dump
|
||||
end interface
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_c_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
|
||||
import
|
||||
implicit none
|
||||
class(amg_c_onelev_type), target, intent(inout) :: lv
|
||||
complex(psb_spk_), intent(in) :: alpha, beta
|
||||
complex(psb_spk_), intent(inout) :: u(:)
|
||||
complex(psb_spk_), intent(out) :: v(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_spk_), optional :: work(:)
|
||||
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)
|
||||
import
|
||||
implicit none
|
||||
class(amg_c_onelev_type), target, intent(inout) :: lv
|
||||
complex(psb_spk_), intent(in) :: alpha, beta
|
||||
type(psb_c_vect_type), intent(inout) :: vect_u, vect_v
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_spk_), optional :: work(:)
|
||||
type(psb_c_vect_type), optional, target, intent(inout) :: vtx,vty
|
||||
end subroutine amg_c_base_onelev_map_rstr_v
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_c_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
|
||||
import
|
||||
implicit none
|
||||
class(amg_c_onelev_type), target, intent(inout) :: lv
|
||||
complex(psb_spk_), intent(in) :: alpha, beta
|
||||
complex(psb_spk_), intent(inout) :: u(:)
|
||||
complex(psb_spk_), intent(out) :: v(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_spk_), optional :: work(:)
|
||||
|
||||
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)
|
||||
import
|
||||
implicit none
|
||||
class(amg_c_onelev_type), target, intent(inout) :: lv
|
||||
complex(psb_spk_), intent(in) :: alpha, beta
|
||||
type(psb_c_vect_type), intent(inout) :: vect_u, vect_v
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
complex(psb_spk_), optional :: work(:)
|
||||
type(psb_c_vect_type), optional, target, intent(inout) :: vtx,vty
|
||||
end subroutine amg_c_base_onelev_map_prol_v
|
||||
end interface
|
||||
|
||||
contains
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
|
||||
function c_base_onelev_get_nzeros(lv) result(val)
|
||||
implicit none
|
||||
implicit none
|
||||
class(amg_c_onelev_type), intent(in) :: lv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
@@ -414,16 +512,16 @@ contains
|
||||
end function c_base_onelev_get_nzeros
|
||||
|
||||
function c_base_onelev_sizeof(lv) result(val)
|
||||
implicit none
|
||||
implicit none
|
||||
class(amg_c_onelev_type), intent(in) :: lv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
|
||||
val = psb_sizeof_ip+psb_sizeof_lp
|
||||
val = val + lv%desc_ac%sizeof()
|
||||
val = val + lv%ac%sizeof()
|
||||
val = val + lv%tprol%sizeof()
|
||||
val = val + lv%map%sizeof()
|
||||
val = val + lv%linmap%sizeof()
|
||||
if (allocated(lv%sm)) val = val + lv%sm%sizeof()
|
||||
if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof()
|
||||
if (allocated(lv%aggr)) val = val + lv%aggr%sizeof()
|
||||
@@ -432,19 +530,19 @@ contains
|
||||
|
||||
|
||||
subroutine c_base_onelev_nullify(lv)
|
||||
implicit none
|
||||
implicit none
|
||||
|
||||
class(amg_c_onelev_type), intent(inout) :: lv
|
||||
|
||||
nullify(lv%base_a)
|
||||
nullify(lv%base_desc)
|
||||
nullify(lv%base_a)
|
||||
nullify(lv%base_desc)
|
||||
nullify(lv%sm2)
|
||||
end subroutine c_base_onelev_nullify
|
||||
|
||||
!
|
||||
! Multilevel defaults:
|
||||
! Multilevel defaults:
|
||||
! multiplicative vs. additive ML framework;
|
||||
! Smoothed decoupled aggregation with zero threshold;
|
||||
! Smoothed decoupled aggregation with zero threshold;
|
||||
! distributed coarse matrix;
|
||||
! damping omega computed with the max-norm estimate of the
|
||||
! dominant eigenvalue;
|
||||
@@ -454,10 +552,10 @@ contains
|
||||
subroutine c_base_onelev_default(lv)
|
||||
|
||||
Implicit None
|
||||
|
||||
|
||||
! Arguments
|
||||
class(amg_c_onelev_type), target, intent(inout) :: lv
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
lv%parms%sweeps_pre = 1
|
||||
lv%parms%sweeps_post = 1
|
||||
@@ -472,7 +570,7 @@ contains
|
||||
lv%parms%aggr_filter = amg_no_filter_mat_
|
||||
lv%parms%aggr_omega_val = szero
|
||||
lv%parms%aggr_thresh = 0.01_psb_spk_
|
||||
|
||||
|
||||
if (allocated(lv%sm)) call lv%sm%default()
|
||||
if (allocated(lv%sm2a)) then
|
||||
call lv%sm2a%default()
|
||||
@@ -482,7 +580,7 @@ contains
|
||||
end if
|
||||
if (.not.allocated(lv%aggr)) allocate(amg_c_dec_aggregator_type :: lv%aggr,stat=info)
|
||||
if (allocated(lv%aggr)) call lv%aggr%default()
|
||||
|
||||
|
||||
return
|
||||
|
||||
end subroutine c_base_onelev_default
|
||||
@@ -497,9 +595,9 @@ contains
|
||||
type(psb_lcspmat_type), intent(out) :: t_prol
|
||||
type(amg_saggr_data), intent(in) :: ag_data
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
call lv%aggr%bld_tprol(lv%parms,ag_data,a,desc_a,ilaggr,nlaggr,t_prol,info)
|
||||
|
||||
|
||||
end subroutine c_base_onelev_bld_tprol
|
||||
|
||||
|
||||
@@ -509,7 +607,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
call lv%aggr%update_next(lvnext%aggr,info)
|
||||
|
||||
|
||||
end subroutine c_base_onelev_update_aggr
|
||||
|
||||
|
||||
@@ -518,33 +616,33 @@ contains
|
||||
Implicit None
|
||||
|
||||
! 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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(lv%sm)) then
|
||||
if (allocated(lv%sm)) then
|
||||
call lv%sm%clone(lvout%sm,info)
|
||||
else
|
||||
if (allocated(lvout%sm)) then
|
||||
else
|
||||
if (allocated(lvout%sm)) then
|
||||
call lvout%sm%free(info)
|
||||
if (info==psb_success_) deallocate(lvout%sm,stat=info)
|
||||
end if
|
||||
end if
|
||||
if (allocated(lv%sm2a)) then
|
||||
if (allocated(lv%sm2a)) then
|
||||
call lv%sm%clone(lvout%sm2a,info)
|
||||
lvout%sm2 => lvout%sm2a
|
||||
else
|
||||
if (allocated(lvout%sm2a)) then
|
||||
else
|
||||
if (allocated(lvout%sm2a)) then
|
||||
call lvout%sm2a%free(info)
|
||||
if (info==psb_success_) deallocate(lvout%sm2a,stat=info)
|
||||
end if
|
||||
lvout%sm2 => lvout%sm
|
||||
end if
|
||||
if (allocated(lv%aggr)) then
|
||||
if (allocated(lv%aggr)) then
|
||||
call lv%aggr%clone(lvout%aggr,info)
|
||||
else
|
||||
if (allocated(lvout%aggr)) then
|
||||
if (allocated(lvout%aggr)) then
|
||||
call lvout%aggr%free(info)
|
||||
if (info==psb_success_) deallocate(lvout%aggr,stat=info)
|
||||
end if
|
||||
@@ -553,10 +651,11 @@ contains
|
||||
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
|
||||
if (info == psb_success_) call lv%tprol%clone(lvout%tprol,info)
|
||||
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
|
||||
if (info == psb_success_) call lv%map%clone(lvout%map,info)
|
||||
if (info == psb_success_) call lv%linmap%clone(lvout%linmap,info)
|
||||
if (info == psb_success_) call lv%remap_data%clone(lvout%remap_data,info)
|
||||
lvout%base_a => lv%base_a
|
||||
lvout%base_desc => lv%base_desc
|
||||
|
||||
|
||||
return
|
||||
|
||||
end subroutine c_base_onelev_clone
|
||||
@@ -565,12 +664,12 @@ contains
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(amg_c_onelev_type), target, intent(inout) :: lv, b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
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
|
||||
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
|
||||
@@ -581,18 +680,18 @@ contains
|
||||
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%map,b%map,info)
|
||||
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)
|
||||
implicit none
|
||||
implicit none
|
||||
class(amg_c_onelev_type), intent(inout) :: lv
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
@@ -613,44 +712,54 @@ contains
|
||||
select case(lv%parms%ml_cycle)
|
||||
case(amg_add_ml_,amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
|
||||
! We're good
|
||||
|
||||
|
||||
case(amg_kcycle_ml_, amg_kcyclesym_ml_)
|
||||
!
|
||||
! We need 7 in inneritkcycle.
|
||||
! Can we reuse vtx?
|
||||
!
|
||||
! Can we reuse vtx?
|
||||
!
|
||||
val = val + 7
|
||||
|
||||
|
||||
case default
|
||||
! Need a better error signaling ?
|
||||
val = -1
|
||||
end select
|
||||
|
||||
|
||||
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
|
||||
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) call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
|
||||
|
||||
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_), intent(out) :: info
|
||||
!
|
||||
integer(psb_ipk_) :: nwv,i
|
||||
integer(psb_ipk_) :: nwv,i
|
||||
info = psb_success_
|
||||
|
||||
if (allocated(lv%wrk)) then
|
||||
@@ -658,46 +767,88 @@ contains
|
||||
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)
|
||||
|
||||
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
|
||||
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)
|
||||
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,&
|
||||
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)
|
||||
end do
|
||||
|
||||
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_), intent(out) :: info
|
||||
!
|
||||
integer(psb_ipk_) :: i
|
||||
info = psb_success_
|
||||
@@ -718,7 +869,7 @@ contains
|
||||
end if
|
||||
|
||||
end subroutine c_wrk_free
|
||||
|
||||
|
||||
subroutine c_wrk_clone(wk,wkout,info)
|
||||
use psb_base_mod
|
||||
Implicit None
|
||||
@@ -726,11 +877,11 @@ contains
|
||||
! 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_), 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)
|
||||
@@ -752,12 +903,12 @@ contains
|
||||
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
|
||||
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
call b%free(info)
|
||||
call move_alloc(wk%tx,b%tx)
|
||||
call move_alloc(wk%ty,b%ty)
|
||||
@@ -770,17 +921,17 @@ contains
|
||||
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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_c_base_vect_type), intent(in), optional :: vmold
|
||||
!
|
||||
integer(psb_ipk_) :: i
|
||||
@@ -801,7 +952,7 @@ contains
|
||||
|
||||
function c_wrk_sizeof(wk) result(val)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
implicit none
|
||||
class(amg_cmlprec_wrk_type), intent(in) :: wk
|
||||
integer(psb_epk_) :: val
|
||||
integer :: i
|
||||
@@ -820,5 +971,25 @@ contains
|
||||
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
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -40,7 +40,7 @@
|
||||
! Module: amg_c_prec_mod
|
||||
!
|
||||
! This module defines the user interfaces to the real/complex, single/double
|
||||
! precision versions of the user-level MLD2P4 routines.
|
||||
! precision versions of the user-level AMG4PSBLAS routines.
|
||||
!
|
||||
module amg_c_prec_mod
|
||||
|
||||
@@ -55,12 +55,7 @@ module amg_c_prec_mod
|
||||
use amg_c_ainv_solver
|
||||
use amg_c_invk_solver
|
||||
use amg_c_invt_solver
|
||||
|
||||
interface amg_precset
|
||||
module procedure amg_c_iprecsetsm, amg_c_iprecsetsv, &
|
||||
& amg_c_cprecseti, amg_c_cprecsetc, amg_c_cprecsetr, &
|
||||
& amg_c_iprecsetag
|
||||
end interface amg_precset
|
||||
use amg_c_krm_solver
|
||||
|
||||
interface amg_extprol_bld
|
||||
subroutine amg_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
|
||||
@@ -82,61 +77,4 @@ module amg_c_prec_mod
|
||||
end subroutine amg_c_extprol_bld
|
||||
end interface amg_extprol_bld
|
||||
|
||||
contains
|
||||
|
||||
subroutine amg_c_iprecsetsm(p,val,info,pos)
|
||||
type(amg_cprec_type), intent(inout) :: p
|
||||
class(amg_c_base_smoother_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(val,info,pos=pos)
|
||||
end subroutine amg_c_iprecsetsm
|
||||
|
||||
subroutine amg_c_iprecsetsv(p,val,info,pos)
|
||||
type(amg_cprec_type), intent(inout) :: p
|
||||
class(amg_c_base_solver_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
call p%set(val,info, pos=pos)
|
||||
end subroutine amg_c_iprecsetsv
|
||||
|
||||
subroutine amg_c_iprecsetag(p,val,info,pos)
|
||||
type(amg_cprec_type), intent(inout) :: p
|
||||
class(amg_c_base_aggregator_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
call p%set(val,info, pos=pos)
|
||||
end subroutine amg_c_iprecsetag
|
||||
|
||||
subroutine amg_c_cprecseti(p,what,val,info,pos)
|
||||
type(amg_cprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_c_cprecseti
|
||||
|
||||
subroutine amg_c_cprecsetr(p,what,val,info,pos)
|
||||
type(amg_cprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_c_cprecsetr
|
||||
|
||||
subroutine amg_c_cprecsetc(p,what,val,info,pos)
|
||||
type(amg_cprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_c_cprecsetc
|
||||
|
||||
end module amg_c_prec_mod
|
||||
|
||||
+124
-17
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -66,7 +66,7 @@ module amg_c_prec_type
|
||||
!
|
||||
! This is the data type containing all the information about the multilevel
|
||||
! preconditioner ('d', 's', 'c' and 'z', according to the real/complex,
|
||||
! single/double precision version of MLD2P4).
|
||||
! single/double precision version of AMG4PSBLAS).
|
||||
! It consists of an array of 'one-level' intermediate data structures
|
||||
! of type amg_conelev_type, each containing the information needed to apply
|
||||
! the smoothing and the coarse-space correction at a generic level. RT is the
|
||||
@@ -135,8 +135,11 @@ module amg_c_prec_type
|
||||
procedure, pass(prec) :: build => amg_cprecbld
|
||||
procedure, pass(prec) :: hierarchy_build => amg_c_hierarchy_bld
|
||||
procedure, pass(prec) :: hierarchy_rebuild => amg_c_hierarchy_rebld
|
||||
procedure, pass(prec) :: hierarchy_free => amg_c_hierarchy_free
|
||||
procedure, pass(prec) :: smoothers_build => amg_c_smoothers_bld
|
||||
procedure, pass(prec) :: smoothers_free => amg_c_smoothers_free
|
||||
procedure, pass(prec) :: descr => amg_cfile_prec_descr
|
||||
procedure, pass(prec) :: memory_use => amg_cfile_prec_memory_use
|
||||
end type amg_cprec_type
|
||||
|
||||
private :: amg_c_dump, amg_c_get_compl, amg_c_cmp_compl,&
|
||||
@@ -155,16 +158,35 @@ module amg_c_prec_type
|
||||
|
||||
|
||||
interface amg_precdescr
|
||||
subroutine amg_cfile_prec_descr(prec,iout,root)
|
||||
subroutine amg_cfile_prec_descr(prec,info,iout,root,verbosity,prefix)
|
||||
import :: amg_cprec_type, psb_ipk_
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_cprec_type), intent(in) :: prec
|
||||
class(amg_cprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_cfile_prec_descr
|
||||
end interface
|
||||
|
||||
|
||||
interface amg_memory_use
|
||||
subroutine amg_cfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
|
||||
import :: amg_cprec_type, psb_ipk_
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_cprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: global
|
||||
end subroutine amg_cfile_prec_memory_use
|
||||
end interface
|
||||
|
||||
interface amg_sizeof
|
||||
module procedure amg_cprec_sizeof
|
||||
end interface
|
||||
@@ -342,6 +364,14 @@ module amg_c_prec_type
|
||||
end subroutine amg_c_smoothers_bld
|
||||
end interface amg_smoothers_bld
|
||||
|
||||
interface amg_smoothers_free
|
||||
module procedure amg_c_smoothers_free
|
||||
end interface amg_smoothers_free
|
||||
|
||||
interface amg_hierarchy_free
|
||||
module procedure amg_c_hierarchy_free
|
||||
end interface amg_hierarchy_free
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning a pointer to the smoother
|
||||
@@ -424,11 +454,22 @@ contains
|
||||
end if
|
||||
end function amg_c_get_nzeros
|
||||
|
||||
function amg_cprec_sizeof(prec) result(val)
|
||||
function amg_cprec_sizeof(prec, global) result(val)
|
||||
implicit none
|
||||
class(amg_cprec_type), intent(in) :: prec
|
||||
integer(psb_epk_) :: val
|
||||
logical, intent(in), optional :: global
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
|
||||
logical :: global_
|
||||
|
||||
if (present(global)) then
|
||||
global_ = global
|
||||
else
|
||||
global_ = .false.
|
||||
end if
|
||||
|
||||
val = 0
|
||||
val = val + psb_sizeof_ip
|
||||
if (allocated(prec%precv)) then
|
||||
@@ -436,6 +477,11 @@ contains
|
||||
val = val + prec%precv(i)%sizeof()
|
||||
end do
|
||||
end if
|
||||
if (global_) then
|
||||
ctxt = prec%ctxt
|
||||
call psb_sum(ctxt,val)
|
||||
end if
|
||||
|
||||
end function amg_cprec_sizeof
|
||||
|
||||
!
|
||||
@@ -599,6 +645,68 @@ contains
|
||||
|
||||
end subroutine amg_c_prec_free
|
||||
|
||||
subroutine amg_c_smoothers_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_c_smoothers_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,size(prec%precv)
|
||||
call prec%precv(i)%free_smoothers(info)
|
||||
end do
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_c_smoothers_free
|
||||
|
||||
subroutine amg_c_hierarchy_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_cprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_c_hierarchy_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
me=-1
|
||||
write(0,*) 'Missing implementation '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_c_hierarchy_free
|
||||
|
||||
|
||||
!
|
||||
@@ -738,16 +846,15 @@ contains
|
||||
character(len=*), intent(in), optional :: prefix, head
|
||||
logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num
|
||||
integer(psb_ipk_) :: i, j, il1, iln, lev
|
||||
type(psb_ctxt_type) :: icontxt
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: iam, np, iproc_
|
||||
character(len=80) :: prefix_
|
||||
character(len=120) :: fname ! len should be at least 20 more than
|
||||
! len of prefix_
|
||||
|
||||
info = 0
|
||||
icontxt = prec%ctxt
|
||||
call psb_info(icontxt,iam,np)
|
||||
|
||||
ctxt = prec%ctxt
|
||||
call psb_info(ctxt,iam,np)
|
||||
iln = size(prec%precv)
|
||||
if (present(istart)) then
|
||||
il1 = max(1,istart)
|
||||
@@ -812,13 +919,13 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
! Local vars
|
||||
integer(psb_ipk_) :: i, j, ln, lev
|
||||
type(psb_ctxt_type) :: icontxt
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: iam, np
|
||||
|
||||
info = psb_success_
|
||||
select type(pout => precout)
|
||||
class is (amg_cprec_type)
|
||||
pout%ctxt = prec%ctxt
|
||||
pout%ctxt = prec%ctxt
|
||||
pout%ag_data = prec%ag_data
|
||||
pout%outer_sweeps = prec%outer_sweeps
|
||||
if (allocated(prec%precv)) then
|
||||
@@ -834,8 +941,8 @@ contains
|
||||
if (info == psb_success_) then
|
||||
pout%precv(lev)%base_a => pout%precv(lev)%ac
|
||||
pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
|
||||
pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
|
||||
pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
|
||||
pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
|
||||
pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
|
||||
end if
|
||||
end do
|
||||
end if
|
||||
@@ -875,8 +982,8 @@ contains
|
||||
do i=2, size(b%precv)
|
||||
b%precv(i)%base_a => b%precv(i)%ac
|
||||
b%precv(i)%base_desc => b%precv(i)%desc_ac
|
||||
b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
|
||||
b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
|
||||
b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
|
||||
b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -385,20 +385,22 @@ contains
|
||||
|
||||
end subroutine c_slu_solver_finalize
|
||||
|
||||
subroutine c_slu_solver_descr(sv,info,iout,coarse)
|
||||
subroutine c_slu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_c_slu_solver_type), intent(in) :: sv
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer :: err_act
|
||||
character(len=20), parameter :: name='amg_c_slu_solver_descr'
|
||||
integer :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -407,8 +409,13 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) ' SuperLU Sparse Factorization Solver. '
|
||||
write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -88,16 +88,25 @@ contains
|
||||
val = "Symmetric Decoupled aggregation"
|
||||
end function amg_c_symdec_aggregator_fmt
|
||||
|
||||
subroutine amg_c_symdec_aggregator_descr(ag,parms,iout,info)
|
||||
subroutine amg_c_symdec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
implicit none
|
||||
class(amg_c_symdec_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
write(iout,*) 'Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
character(1024) :: prefix_
|
||||
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
|
||||
return
|
||||
end subroutine amg_c_symdec_aggregator_descr
|
||||
|
||||
@@ -1,11 +1,14 @@
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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
|
||||
@@ -55,13 +58,10 @@ module amg_d_ainv_solver
|
||||
procedure, pass(sv) :: check => amg_d_ainv_solver_check
|
||||
procedure, pass(sv) :: build => amg_d_ainv_solver_bld
|
||||
procedure, pass(sv) :: clone => amg_d_ainv_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_d_ainv_solver_clone_settings
|
||||
procedure, pass(sv) :: cseti => amg_d_ainv_solver_cseti
|
||||
procedure, pass(sv) :: csetc => amg_d_ainv_solver_csetc
|
||||
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
|
||||
generic, public :: set => seti, setr, setc
|
||||
procedure, pass(sv) :: descr => amg_d_ainv_solver_descr
|
||||
procedure, pass(sv) :: default => d_ainv_solver_default
|
||||
procedure, nopass :: stringval => d_ainv_stringval
|
||||
@@ -83,6 +83,16 @@ module amg_d_ainv_solver
|
||||
end subroutine amg_d_ainv_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_ainv_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& amg_d_base_solver_type, psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_d_ainv_solver_type), intent(inout) :: sv
|
||||
class(amg_d_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_ainv_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
@@ -159,44 +169,44 @@ module amg_d_ainv_solver
|
||||
end subroutine amg_d_ainv_solver_csetr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_ainv_solver_setc(sv,what,val,info)
|
||||
import :: amg_d_ainv_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_d_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_ainv_solver_setc
|
||||
end interface
|
||||
!!$ interface
|
||||
!!$ subroutine amg_d_ainv_solver_setc(sv,what,val,info)
|
||||
!!$ import :: amg_d_ainv_solver_type, psb_ipk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_d_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ character(len=*), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_d_ainv_solver_setc
|
||||
!!$ end interface
|
||||
!!$
|
||||
!!$ interface
|
||||
!!$ subroutine amg_d_ainv_solver_seti(sv,what,val,info)
|
||||
!!$ import :: amg_d_ainv_solver_type, psb_ipk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_d_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ integer(psb_ipk_), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_d_ainv_solver_seti
|
||||
!!$ end interface
|
||||
!!$
|
||||
!!$ interface
|
||||
!!$ subroutine amg_d_ainv_solver_setr(sv,what,val,info)
|
||||
!!$ import :: amg_d_ainv_solver_type, psb_ipk_, psb_dpk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_d_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ real(psb_dpk_), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_d_ainv_solver_setr
|
||||
!!$ end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_ainv_solver_seti(sv,what,val,info)
|
||||
import :: amg_d_ainv_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_d_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_ainv_solver_seti
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_ainv_solver_setr(sv,what,val,info)
|
||||
import :: amg_d_ainv_solver_type, psb_ipk_, psb_dpk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_d_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_ainv_solver_setr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse)
|
||||
subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse,prefix)
|
||||
import :: psb_dpk_, amg_d_ainv_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -206,7 +216,7 @@ module amg_d_ainv_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_d_ainv_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -396,21 +396,23 @@ contains
|
||||
end subroutine d_as_smoother_default
|
||||
|
||||
|
||||
subroutine d_as_smoother_descr(sm,info,iout,coarse)
|
||||
subroutine d_as_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_as_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_as_smoother_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
logical :: coarse_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -424,16 +426,21 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (.not.coarse_) then
|
||||
write(iout_,*) ' Additive Schwarz with ',&
|
||||
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
|
||||
& sm%novr, ' overlap layers.'
|
||||
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) ' Local solver:'
|
||||
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) trim(prefix_), ' Local solver:'
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%descr(info,iout_,coarse=coarse)
|
||||
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -126,7 +126,7 @@ module amg_d_base_aggregator_mod
|
||||
& psb_d_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
|
||||
implicit none
|
||||
type(psb_d_csr_sparse_mat), intent(inout) :: a_csr
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: nlaggr(:)
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_d_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
|
||||
@@ -144,7 +144,7 @@ module amg_d_base_aggregator_mod
|
||||
& psb_d_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
|
||||
implicit none
|
||||
type(psb_d_csr_sparse_mat), intent(inout) :: a_csr
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: nlaggr(:)
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_d_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
|
||||
@@ -275,15 +275,22 @@ contains
|
||||
val = .false.
|
||||
end function amg_d_base_aggregator_xt_desc
|
||||
|
||||
subroutine amg_d_base_aggregator_descr(ag,parms,iout,info)
|
||||
subroutine amg_d_base_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
implicit none
|
||||
class(amg_d_base_aggregator_type), intent(in) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
|
||||
return
|
||||
end subroutine amg_d_base_aggregator_descr
|
||||
|
||||
@@ -1,11 +1,14 @@
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -272,7 +272,7 @@ module amg_d_base_smoother_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_base_smoother_descr(sm,info,iout,coarse)
|
||||
subroutine amg_d_base_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
& amg_d_base_smoother_type, psb_ipk_
|
||||
@@ -281,6 +281,7 @@ module amg_d_base_smoother_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_d_base_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -270,7 +270,7 @@ module amg_d_base_solver_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_base_solver_descr(sv,info,iout,coarse)
|
||||
subroutine amg_d_base_solver_descr(sv,info,iout,coarse,prefix)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
& amg_d_base_solver_type, psb_ipk_
|
||||
@@ -281,7 +281,7 @@ module amg_d_base_solver_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_d_base_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -184,16 +184,23 @@ contains
|
||||
val = "Decoupled aggregation"
|
||||
end function amg_d_dec_aggregator_fmt
|
||||
|
||||
subroutine amg_d_dec_aggregator_descr(ag,parms,iout,info)
|
||||
subroutine amg_d_dec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
implicit none
|
||||
class(amg_d_dec_aggregator_type), intent(in) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) 'Decoupled Aggregator'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
|
||||
return
|
||||
end subroutine amg_d_dec_aggregator_descr
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -219,7 +219,7 @@ contains
|
||||
|
||||
end subroutine d_diag_solver_free
|
||||
|
||||
subroutine d_diag_solver_descr(sv,info,iout,coarse)
|
||||
subroutine d_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -228,11 +228,13 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -240,8 +242,13 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
|
||||
write(iout_,*) ' Diagonal local solver '
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Diagonal local solver '
|
||||
|
||||
return
|
||||
|
||||
@@ -352,7 +359,7 @@ module amg_d_l1_diag_solver
|
||||
|
||||
contains
|
||||
|
||||
subroutine d_l1_diag_solver_descr(sv,info,iout,coarse)
|
||||
subroutine d_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -361,11 +368,13 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_l1_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -373,8 +382,13 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
|
||||
write(iout_,*) ' L1 Diagonal solver '
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
+28
-14
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -433,20 +433,22 @@ contains
|
||||
return
|
||||
end subroutine d_gs_solver_free
|
||||
|
||||
subroutine d_gs_solver_descr(sv,info,iout,coarse)
|
||||
subroutine d_gs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_gs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_gs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -455,12 +457,17 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
@@ -526,20 +533,22 @@ contains
|
||||
val = .true.
|
||||
end function d_gs_solver_is_iterative
|
||||
|
||||
subroutine d_bwgs_solver_descr(sv,info,iout,coarse)
|
||||
subroutine d_bwgs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_bwgs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_bwgs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -548,12 +557,17 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
|
||||
@@ -1,125 +0,0 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (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,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -157,7 +157,7 @@ contains
|
||||
return
|
||||
end subroutine d_id_solver_free
|
||||
|
||||
subroutine d_id_solver_descr(sv,info,iout,coarse)
|
||||
subroutine d_id_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -165,12 +165,14 @@ contains
|
||||
class(amg_d_id_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_id_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -178,8 +180,13 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) ' Identity local solver '
|
||||
write(iout_,*) trim(prefix_), ' Identity local solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -234,7 +234,7 @@ contains
|
||||
! Arguments
|
||||
class(amg_d_ilu_solver_type), intent(inout) :: sv
|
||||
|
||||
sv%fact_type = psb_ilu_n_
|
||||
sv%fact_type = amg_ilu_n_
|
||||
sv%fill_in = 0
|
||||
sv%thresh = dzero
|
||||
|
||||
@@ -255,13 +255,13 @@ contains
|
||||
info = psb_success_
|
||||
|
||||
call amg_check_def(sv%fact_type,&
|
||||
& 'Factorization',psb_ilu_n_,is_legal_ilu_fact)
|
||||
& 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
|
||||
|
||||
select case(sv%fact_type)
|
||||
case(psb_ilu_n_,psb_milu_n_)
|
||||
case(amg_ilu_n_,amg_milu_n_)
|
||||
call amg_check_def(sv%fill_in,&
|
||||
& 'Level',izero,is_int_non_negative)
|
||||
case(psb_ilu_t_)
|
||||
case(amg_ilu_t_)
|
||||
call amg_check_def(sv%thresh,&
|
||||
& 'Eps',dzero,is_legal_d_fact_thrs)
|
||||
end select
|
||||
@@ -406,7 +406,7 @@ contains
|
||||
return
|
||||
end subroutine d_ilu_solver_free
|
||||
|
||||
subroutine d_ilu_solver_descr(sv,info,iout,coarse)
|
||||
subroutine d_ilu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -414,12 +414,14 @@ contains
|
||||
class(amg_d_ilu_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_ilu_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -428,15 +430,20 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) ' Incomplete factorization solver: ',&
|
||||
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
|
||||
& amg_fact_names(sv%fact_type)
|
||||
select case(sv%fact_type)
|
||||
case(psb_ilu_n_,psb_milu_n_)
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
case(psb_ilu_t_)
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill threshold :',sv%thresh
|
||||
case(amg_ilu_n_,amg_milu_n_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
case(amg_ilu_t_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -489,7 +496,7 @@ contains
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = psb_ilu_n_
|
||||
val = amg_ilu_n_
|
||||
end function d_ilu_solver_get_id
|
||||
|
||||
function d_ilu_solver_get_wrksize() result(val)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -39,7 +39,7 @@
|
||||
!
|
||||
! Module: amg_inner_mod
|
||||
!
|
||||
! This module defines the interfaces to inner MLD2P4 routines.
|
||||
! This module defines the interfaces to inner AMG4PSBLAS routines.
|
||||
! The interfaces of the user level routines are defined in amg_prec_mod.f90.
|
||||
!
|
||||
module amg_d_inner_mod
|
||||
@@ -109,11 +109,12 @@ module amg_d_inner_mod
|
||||
end interface amg_map_to_tprol
|
||||
|
||||
abstract interface
|
||||
subroutine amg_daggrmat_var_bld(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
subroutine amg_daggrmat_var_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_, psb_lpk_, psb_ldspmat_type
|
||||
import :: amg_d_onelev_type, amg_dml_parms
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: dol1smoothing
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
|
||||
@@ -1,11 +1,14 @@
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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
|
||||
@@ -49,10 +52,9 @@ module amg_d_invk_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_d_invk_solver_check
|
||||
procedure, pass(sv) :: clone => amg_d_invk_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_d_invk_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_d_invk_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_d_invk_solver_cseti
|
||||
procedure, pass(sv) :: seti => amg_d_invk_solver_seti
|
||||
generic, public :: set => seti
|
||||
procedure, pass(sv) :: descr => amg_d_invk_solver_descr
|
||||
procedure, pass(sv) :: default => d_invk_solver_default
|
||||
end type amg_d_invk_solver_type
|
||||
@@ -72,6 +74,17 @@ module amg_d_invk_solver
|
||||
end subroutine amg_d_invk_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invk_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& amg_d_base_solver_type, psb_dpk_, amg_d_invk_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_d_invk_solver_type), intent(inout) :: sv
|
||||
class(amg_d_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_invk_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
@@ -122,7 +135,7 @@ module amg_d_invk_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invk_solver_descr(sv,info,iout,coarse)
|
||||
subroutine amg_d_invk_solver_descr(sv,info,iout,coarse,prefix)
|
||||
import :: psb_dpk_, amg_d_invk_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -132,22 +145,10 @@ module amg_d_invk_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_d_invk_solver_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invk_solver_seti(sv,what,val,info)
|
||||
import :: amg_d_invk_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_d_invk_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_invk_solver_seti
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine d_invk_solver_default(sv)
|
||||
|
||||
@@ -1,11 +1,14 @@
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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
|
||||
@@ -49,12 +52,10 @@ module amg_d_invt_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_d_invt_solver_check
|
||||
procedure, pass(sv) :: clone => amg_d_invt_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_d_invt_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_d_invt_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_d_invt_solver_cseti
|
||||
procedure, pass(sv) :: csetr => amg_d_invt_solver_csetr
|
||||
procedure, pass(sv) :: seti => amg_d_invt_solver_seti
|
||||
procedure, pass(sv) :: setr => amg_d_invt_solver_setr
|
||||
generic, public :: set => seti, setr
|
||||
procedure, pass(sv) :: descr => amg_d_invt_solver_descr
|
||||
procedure, pass(sv) :: default => d_invt_solver_default
|
||||
end type amg_d_invt_solver_type
|
||||
@@ -73,6 +74,17 @@ module amg_d_invt_solver
|
||||
end subroutine amg_d_invt_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invt_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& amg_d_base_solver_type, psb_dpk_, amg_d_invt_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_d_invt_solver_type), intent(inout) :: sv
|
||||
class(amg_d_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_invt_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
@@ -134,44 +146,21 @@ module amg_d_invt_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invt_solver_descr(sv,info,iout,coarse)
|
||||
subroutine amg_d_invt_solver_descr(sv,info,iout,coarse,prefix)
|
||||
import :: psb_dpk_, amg_d_invt_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_invt_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_d_invt_solver_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invt_solver_setr(sv,what,val,info)
|
||||
import :: amg_d_invt_solver_type, psb_dpk_, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_d_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_invt_solver_setr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_invt_solver_seti(sv,what,val,info)
|
||||
import :: amg_d_invt_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_d_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine d_invt_solver_default(sv)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -203,8 +203,8 @@ module amg_d_jac_smoother
|
||||
subroutine amg_d_jac_smoother_clone_settings(sm,smout,info)
|
||||
import :: amg_d_jac_smoother_type, psb_dpk_, &
|
||||
& amg_d_base_smoother_type, psb_ipk_
|
||||
class(amg_d_jac_smoother_type), intent(inout) :: sm
|
||||
class(amg_d_base_smoother_type), allocatable, intent(inout) :: smout
|
||||
class(amg_d_jac_smoother_type), intent(inout) :: sm
|
||||
class(amg_d_base_smoother_type), intent(inout) :: smout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_jac_smoother_clone_settings
|
||||
end interface
|
||||
@@ -219,12 +219,13 @@ module amg_d_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse)
|
||||
subroutine amg_d_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
import :: amg_d_jac_smoother_type, psb_ipk_
|
||||
class(amg_d_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_d_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
@@ -313,12 +314,13 @@ module amg_d_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse)
|
||||
subroutine amg_d_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
import :: amg_d_l1_jac_smoother_type, psb_ipk_
|
||||
class(amg_d_l1_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_d_l1_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -0,0 +1,585 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! File: amg_d_jac_solver_mod.f90
|
||||
!
|
||||
! Module: amg_d_jac_solver_mod
|
||||
!
|
||||
! This module defines:
|
||||
! - the amg_d_jac_solver_type data structure containing the ingredients
|
||||
! for a local Jacobi iteration. The iterations are local to a process
|
||||
! (they operate on the block diagonal).
|
||||
!
|
||||
!
|
||||
module amg_d_jac_solver
|
||||
|
||||
use amg_d_base_solver_mod
|
||||
|
||||
type, extends(amg_d_base_solver_type) :: amg_d_jac_solver_type
|
||||
type(psb_dspmat_type) :: a
|
||||
type(psb_d_vect_type), allocatable :: dv
|
||||
real(psb_dpk_), allocatable :: d(:)
|
||||
integer(psb_ipk_) :: sweeps
|
||||
real(psb_dpk_) :: eps
|
||||
contains
|
||||
procedure, pass(sv) :: dump => amg_d_jac_solver_dmp
|
||||
procedure, pass(sv) :: check => d_jac_solver_check
|
||||
procedure, pass(sv) :: clone => amg_d_jac_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_d_jac_solver_clone_settings
|
||||
procedure, pass(sv) :: clear_data => amg_d_jac_solver_clear_data
|
||||
procedure, pass(sv) :: build => amg_d_jac_solver_bld
|
||||
procedure, pass(sv) :: cnv => amg_d_jac_solver_cnv
|
||||
procedure, pass(sv) :: apply_v => amg_d_jac_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => amg_d_jac_solver_apply
|
||||
procedure, pass(sv) :: free => d_jac_solver_free
|
||||
procedure, pass(sv) :: cseti => d_jac_solver_cseti
|
||||
procedure, pass(sv) :: csetc => d_jac_solver_csetc
|
||||
procedure, pass(sv) :: csetr => d_jac_solver_csetr
|
||||
procedure, pass(sv) :: descr => d_jac_solver_descr
|
||||
procedure, pass(sv) :: default => d_jac_solver_default
|
||||
procedure, pass(sv) :: sizeof => d_jac_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => d_jac_solver_get_nzeros
|
||||
procedure, nopass :: get_wrksz => d_jac_solver_get_wrksize
|
||||
procedure, nopass :: get_fmt => d_jac_solver_get_fmt
|
||||
procedure, nopass :: get_id => d_jac_solver_get_id
|
||||
procedure, nopass :: is_iterative => d_jac_solver_is_iterative
|
||||
end type amg_d_jac_solver_type
|
||||
|
||||
type, extends(amg_d_jac_solver_type) :: amg_d_l1_jac_solver_type
|
||||
contains
|
||||
procedure, pass(sv) :: build => amg_d_l1_jac_solver_bld
|
||||
procedure, pass(sv) :: descr => d_l1_jac_solver_descr
|
||||
procedure, nopass :: get_fmt => d_l1_jac_solver_get_fmt
|
||||
procedure, nopass :: get_id => d_l1_jac_solver_get_id
|
||||
end type amg_d_l1_jac_solver_type
|
||||
|
||||
|
||||
private :: d_jac_solver_bld, d_jac_solver_apply, &
|
||||
& d_jac_solver_free, &
|
||||
& d_jac_solver_descr, d_jac_solver_sizeof, &
|
||||
& d_jac_solver_default, d_jac_solver_dmp, &
|
||||
& d_jac_solver_apply_vect, d_jac_solver_get_nzeros, &
|
||||
& d_jac_solver_get_fmt, d_jac_solver_check,&
|
||||
& d_jac_solver_is_iterative, &
|
||||
& d_jac_solver_get_id, d_jac_solver_get_wrksize
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_jac_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_jac_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
|
||||
import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_jac_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_jac_solver_apply
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_jac_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_jac_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_d_l1_jac_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_l1_jac_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_l1_jac_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_solver_cnv(sv,info,amold,vmold,imold)
|
||||
import :: amg_d_jac_solver_type, psb_dpk_, &
|
||||
& psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
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_jac_solver_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
|
||||
import :: psb_desc_type, amg_d_jac_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, &
|
||||
& psb_ipk_
|
||||
implicit none
|
||||
class(amg_d_jac_solver_type), intent(in) :: sv
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix, head
|
||||
logical, optional, intent(in) :: solver, global_num
|
||||
end subroutine amg_d_jac_solver_dmp
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_solver_clone(sv,svout,info)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
& amg_d_base_solver_type, amg_d_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_jac_solver_clone
|
||||
end interface
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine amg_d_l1_jac_solver_clone(sv,svout,info)
|
||||
!!$ import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
!!$ & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
!!$ & amg_d_base_solver_type, amg_d_l1_jac_solver_type, psb_ipk_
|
||||
!!$ Implicit None
|
||||
!!$
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_d_l1_jac_solver_type), intent(inout) :: sv
|
||||
!!$ class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_d_l1_jac_solver_clone
|
||||
!!$ end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
& amg_d_base_solver_type, amg_d_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
class(amg_d_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_jac_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_jac_solver_clear_data(sv,info)
|
||||
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
|
||||
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
|
||||
& amg_d_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_jac_solver_clear_data
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine d_jac_solver_default(sv)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
|
||||
sv%sweeps = ione
|
||||
sv%eps = dzero
|
||||
|
||||
return
|
||||
end subroutine d_jac_solver_default
|
||||
|
||||
subroutine d_jac_solver_check(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_jac_solver_check'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
call amg_check_def(sv%sweeps,&
|
||||
& 'Jacobi sweeps',ione,is_int_positive)
|
||||
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine d_jac_solver_check
|
||||
|
||||
subroutine d_jac_solver_cseti(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_jac_solver_cseti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('SOLVER_SWEEPS')
|
||||
sv%sweeps = val
|
||||
case default
|
||||
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_jac_solver_cseti
|
||||
|
||||
subroutine d_jac_solver_csetc(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='d_jac_solver_csetc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_jac_solver_csetc
|
||||
|
||||
subroutine d_jac_solver_csetr(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_jac_solver_csetr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('SOLVER_EPS')
|
||||
sv%eps = val
|
||||
case default
|
||||
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
|
||||
end select
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_jac_solver_csetr
|
||||
|
||||
subroutine d_jac_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_jac_solver_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
call sv%a%free()
|
||||
if (allocated(sv%dv)) then
|
||||
call sv%dv%free(info)
|
||||
deallocate(sv%dv)
|
||||
end if
|
||||
if (allocated(sv%d)) deallocate(sv%d)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_jac_solver_free
|
||||
|
||||
subroutine d_jac_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_jac_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
iout_ = iout
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_jac_solver_descr
|
||||
|
||||
function d_jac_solver_get_nzeros(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = 0
|
||||
val = val + sv%a%get_nzeros()
|
||||
val = val + sv%dv%get_nrows()
|
||||
|
||||
return
|
||||
end function d_jac_solver_get_nzeros
|
||||
|
||||
function d_jac_solver_sizeof(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_d_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = psb_sizeof_ip
|
||||
val = val + sv%a%sizeof()
|
||||
val = val + sv%dv%sizeof()
|
||||
|
||||
return
|
||||
end function d_jac_solver_sizeof
|
||||
|
||||
function d_jac_solver_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Jacobi solver"
|
||||
end function d_jac_solver_get_fmt
|
||||
|
||||
function d_jac_solver_get_id() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_jac_
|
||||
end function d_jac_solver_get_id
|
||||
|
||||
!
|
||||
! If this is true, then the solver needs a starting
|
||||
! guess. Currently only handled in JAC smoother.
|
||||
!
|
||||
function d_jac_solver_is_iterative() result(val)
|
||||
implicit none
|
||||
logical :: val
|
||||
|
||||
val = .true.
|
||||
end function d_jac_solver_is_iterative
|
||||
|
||||
function d_jac_solver_get_wrksize() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = 2
|
||||
end function d_jac_solver_get_wrksize
|
||||
|
||||
subroutine d_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_l1_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_l1_jac_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
iout_ = iout
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_l1_jac_solver_descr
|
||||
|
||||
function d_l1_jac_solver_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "L1-Jacobi solver"
|
||||
end function d_l1_jac_solver_get_fmt
|
||||
|
||||
function d_l1_jac_solver_get_id() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_l1_jac_
|
||||
end function d_l1_jac_solver_get_id
|
||||
|
||||
end module amg_d_jac_solver
|
||||
@@ -1,11 +1,14 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
@@ -52,14 +55,14 @@
|
||||
! 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 MLD2P4 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
|
||||
! 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 MLD2P4 GROUP OR ITS CONTRIBUTORS
|
||||
! 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
|
||||
@@ -70,16 +73,16 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
! File: amg_d_rkr_solver_mod.f90
|
||||
! File: amg_d_krm_solver_mod.f90
|
||||
!
|
||||
! Module: amg_d_rkr_solver_mod
|
||||
! Module: amg_d_krm_solver_mod
|
||||
!
|
||||
module amg_d_rkr_solver
|
||||
module amg_d_krm_solver
|
||||
|
||||
use amg_d_base_solver_mod
|
||||
use amg_d_prec_type
|
||||
|
||||
type, extends(amg_d_base_solver_type) :: amg_d_rkr_solver_type
|
||||
type, extends(amg_d_base_solver_type) :: amg_d_krm_solver_type
|
||||
!
|
||||
logical :: global
|
||||
character(len=16) :: method, kprec, sub_solve
|
||||
@@ -94,46 +97,46 @@ module amg_d_rkr_solver
|
||||
contains
|
||||
!
|
||||
!
|
||||
procedure, pass(sv) :: dump => d_rkr_solver_dmp
|
||||
procedure, pass(sv) :: check => d_rkr_solver_check
|
||||
procedure, pass(sv) :: clone => d_rkr_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => d_rkr_solver_clone_settings
|
||||
procedure, pass(sv) :: cnv => d_rkr_solver_cnv
|
||||
procedure, pass(sv) :: apply_v => amg_d_rkr_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => amg_d_rkr_solver_apply
|
||||
procedure, pass(sv) :: clear_data => d_rkr_solver_clear_data
|
||||
procedure, pass(sv) :: free => d_rkr_solver_free
|
||||
procedure, pass(sv) :: cseti => d_rkr_solver_cseti
|
||||
procedure, pass(sv) :: csetc => d_rkr_solver_csetc
|
||||
procedure, pass(sv) :: csetr => d_rkr_solver_csetr
|
||||
procedure, pass(sv) :: sizeof => d_rkr_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => d_rkr_solver_get_nzeros
|
||||
!procedure, nopass :: get_id => d_rkr_solver_get_id
|
||||
procedure, pass(sv) :: is_global => d_rkr_solver_is_global
|
||||
procedure, nopass :: is_iterative => d_rkr_solver_is_iterative
|
||||
procedure, pass(sv) :: dump => d_krm_solver_dmp
|
||||
procedure, pass(sv) :: check => d_krm_solver_check
|
||||
procedure, pass(sv) :: clone => d_krm_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => d_krm_solver_clone_settings
|
||||
procedure, pass(sv) :: cnv => d_krm_solver_cnv
|
||||
procedure, pass(sv) :: apply_v => amg_d_krm_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => amg_d_krm_solver_apply
|
||||
procedure, pass(sv) :: clear_data => d_krm_solver_clear_data
|
||||
procedure, pass(sv) :: free => d_krm_solver_free
|
||||
procedure, pass(sv) :: cseti => d_krm_solver_cseti
|
||||
procedure, pass(sv) :: csetc => d_krm_solver_csetc
|
||||
procedure, pass(sv) :: csetr => d_krm_solver_csetr
|
||||
procedure, pass(sv) :: sizeof => d_krm_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => d_krm_solver_get_nzeros
|
||||
!procedure, nopass :: get_id => d_krm_solver_get_id
|
||||
procedure, pass(sv) :: is_global => d_krm_solver_is_global
|
||||
procedure, nopass :: is_iterative => d_krm_solver_is_iterative
|
||||
|
||||
|
||||
!
|
||||
! These methods are specific for the new solver type
|
||||
! and therefore need to be overridden
|
||||
!
|
||||
procedure, pass(sv) :: descr => d_rkr_solver_descr
|
||||
procedure, pass(sv) :: default => d_rkr_solver_default
|
||||
procedure, pass(sv) :: build => amg_d_rkr_solver_bld
|
||||
procedure, nopass :: get_fmt => d_rkr_solver_get_fmt
|
||||
end type amg_d_rkr_solver_type
|
||||
procedure, pass(sv) :: descr => d_krm_solver_descr
|
||||
procedure, pass(sv) :: default => d_krm_solver_default
|
||||
procedure, pass(sv) :: build => amg_d_krm_solver_bld
|
||||
procedure, nopass :: get_fmt => d_krm_solver_get_fmt
|
||||
end type amg_d_krm_solver_type
|
||||
|
||||
|
||||
private :: d_rkr_solver_get_fmt, d_rkr_solver_descr, d_rkr_solver_default
|
||||
private :: d_krm_solver_get_fmt, d_krm_solver_descr, d_krm_solver_default
|
||||
|
||||
interface
|
||||
subroutine amg_d_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
subroutine amg_d_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
import :: psb_desc_type, amg_d_rkr_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
import :: psb_desc_type, amg_d_krm_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_d_krm_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
|
||||
@@ -143,17 +146,17 @@ module amg_d_rkr_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_d_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_d_rkr_solver_apply_vect
|
||||
end subroutine amg_d_krm_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
subroutine amg_d_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
import :: psb_desc_type, amg_d_rkr_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
import :: psb_desc_type, amg_d_krm_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
real(psb_dpk_),intent(inout) :: x(:)
|
||||
real(psb_dpk_),intent(inout) :: y(:)
|
||||
real(psb_dpk_),intent(in) :: alpha,beta
|
||||
@@ -162,24 +165,24 @@ module amg_d_rkr_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_dpk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_d_rkr_solver_apply
|
||||
end subroutine amg_d_krm_solver_apply
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_d_rkr_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
subroutine amg_d_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_d_krm_solver_type, psb_d_vect_type, psb_dpk_, &
|
||||
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_d_krm_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_rkr_solver_bld
|
||||
end subroutine amg_d_krm_solver_bld
|
||||
end interface
|
||||
|
||||
|
||||
@@ -187,12 +190,12 @@ contains
|
||||
|
||||
!
|
||||
!
|
||||
subroutine d_rkr_solver_default(sv)
|
||||
subroutine d_krm_solver_default(sv)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
|
||||
sv%method = 'bicgstab'
|
||||
sv%kprec = 'bjac'
|
||||
@@ -207,42 +210,42 @@ contains
|
||||
sv%global = .false.
|
||||
|
||||
return
|
||||
end subroutine d_rkr_solver_default
|
||||
end subroutine d_krm_solver_default
|
||||
|
||||
function d_rkr_solver_get_nzeros(sv) result(val)
|
||||
function d_krm_solver_get_nzeros(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_d_rkr_solver_type), intent(in) :: sv
|
||||
class(amg_d_krm_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = sv%prec%get_nzeros()
|
||||
|
||||
return
|
||||
end function d_rkr_solver_get_nzeros
|
||||
end function d_krm_solver_get_nzeros
|
||||
|
||||
function d_rkr_solver_sizeof(sv) result(val)
|
||||
function d_krm_solver_sizeof(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_d_rkr_solver_type), intent(in) :: sv
|
||||
class(amg_d_krm_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = sv%prec%sizeof() + sv%desc_local%sizeof() + sv%a_local%sizeof()
|
||||
|
||||
return
|
||||
end function d_rkr_solver_sizeof
|
||||
end function d_krm_solver_sizeof
|
||||
|
||||
|
||||
subroutine d_rkr_solver_check(sv,info)
|
||||
subroutine d_krm_solver_check(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_rkr_solver_check'
|
||||
character(len=20) :: name='d_krm_solver_check'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -256,36 +259,36 @@ contains
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine d_rkr_solver_check
|
||||
end subroutine d_krm_solver_check
|
||||
|
||||
subroutine d_rkr_solver_cseti(sv,what,val,info,idx)
|
||||
subroutine d_krm_solver_cseti(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_rkr_solver_cseti'
|
||||
character(len=20) :: name='d_krm_solver_cseti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('RKR_IRST')
|
||||
case('KRM_IRST')
|
||||
sv%irst = val
|
||||
case('RKR_ISTOPC')
|
||||
case('KRM_ISTOPC')
|
||||
sv%istopc = val
|
||||
case('RKR_ITMAX')
|
||||
case('KRM_ITMAX')
|
||||
sv%itmax = val
|
||||
case('RKR_ITRACE')
|
||||
case('KRM_ITRACE')
|
||||
sv%itrace = val
|
||||
case('RKR_SUB_SOLVE')
|
||||
case('KRM_SUB_SOLVE')
|
||||
sv%i_sub_solve = val
|
||||
case('RKR_FILLIN')
|
||||
case('KRM_FILLIN')
|
||||
sv%fillin = val
|
||||
case default
|
||||
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
|
||||
@@ -296,33 +299,33 @@ contains
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_rkr_solver_cseti
|
||||
end subroutine d_krm_solver_cseti
|
||||
|
||||
subroutine d_rkr_solver_csetc(sv,what,val,info,idx)
|
||||
subroutine d_krm_solver_csetc(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='d_rkr_solver_csetc'
|
||||
character(len=20) :: name='d_krm_solver_csetc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('RKR_METHOD')
|
||||
case('KRM_METHOD')
|
||||
sv%method = psb_toupper(trim(val))
|
||||
case('RKR_KPREC')
|
||||
case('KRM_KPREC')
|
||||
sv%kprec = psb_toupper(trim(val))
|
||||
case('RKR_SUB_SOLVE')
|
||||
case('KRM_SUB_SOLVE')
|
||||
sv%sub_solve = psb_toupper(trim(val))
|
||||
case('RKR_GLOBAL')
|
||||
case('KRM_GLOBAL')
|
||||
select case(psb_toupper(trim(val)))
|
||||
case('LOCAL','FALSE')
|
||||
sv%global = .false.
|
||||
@@ -345,26 +348,26 @@ contains
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_rkr_solver_csetc
|
||||
end subroutine d_krm_solver_csetc
|
||||
|
||||
subroutine d_rkr_solver_csetr(sv,what,val,info,idx)
|
||||
subroutine d_krm_solver_csetr(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_rkr_solver_csetr'
|
||||
character(len=20) :: name='d_krm_solver_csetr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('RKR_EPS')
|
||||
case('KRM_EPS')
|
||||
sv%eps = val
|
||||
case default
|
||||
call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
|
||||
@@ -375,18 +378,18 @@ contains
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_rkr_solver_csetr
|
||||
end subroutine d_krm_solver_csetr
|
||||
|
||||
subroutine d_rkr_solver_clear_data(sv,info)
|
||||
subroutine d_krm_solver_clear_data(sv,info)
|
||||
use psb_base_mod, only : psb_exit
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
type(psb_ctxt_type) :: l_ctxt
|
||||
character(len=20) :: name='d_rkr_solver_free'
|
||||
character(len=20) :: name='d_krm_solver_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -403,19 +406,19 @@ contains
|
||||
nullify(sv%a)
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
end subroutine d_rkr_solver_clear_data
|
||||
end subroutine d_krm_solver_clear_data
|
||||
|
||||
|
||||
subroutine d_rkr_solver_free(sv,info)
|
||||
subroutine d_krm_solver_free(sv,info)
|
||||
use psb_base_mod, only : psb_exit
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
type(psb_ctxt_type) :: l_ctxt
|
||||
character(len=20) :: name='d_rkr_solver_free'
|
||||
character(len=20) :: name='d_krm_solver_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -424,29 +427,31 @@ contains
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
end subroutine d_rkr_solver_free
|
||||
end subroutine d_krm_solver_free
|
||||
|
||||
function d_rkr_solver_get_fmt() result(val)
|
||||
function d_krm_solver_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "RKR solver"
|
||||
end function d_rkr_solver_get_fmt
|
||||
val = "KRM solver"
|
||||
end function d_krm_solver_get_fmt
|
||||
|
||||
subroutine d_rkr_solver_descr(sv,info,iout,coarse)
|
||||
subroutine d_krm_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_rkr_solver_type), intent(in) :: sv
|
||||
class(amg_d_krm_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_d_rkr_solver_descr'
|
||||
character(len=20), parameter :: name='amg_d_krm_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -455,34 +460,33 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%global) then
|
||||
write(iout_,*) ' Recursive Krylov solver (global)'
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
|
||||
else
|
||||
write(iout_,*) ' Recursive Krylov solver (local) '
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
|
||||
end if
|
||||
write(iout_,*) ' method: ',sv%method
|
||||
write(iout_,*) ' kprec: ',sv%kprec
|
||||
if (sv%i_sub_solve > 0) then
|
||||
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
|
||||
else
|
||||
write(iout_,*) ' sub_solve: ',sv%sub_solve
|
||||
end if
|
||||
write(iout_,*) ' itmax: ',sv%itmax
|
||||
write(iout_,*) ' eps: ',sv%eps
|
||||
write(iout_,*) ' fillin: ',sv%fillin
|
||||
|
||||
write(iout_,*) trim(prefix_), ' method: ',sv%method
|
||||
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
|
||||
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
|
||||
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
|
||||
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_rkr_solver_descr
|
||||
end subroutine d_krm_solver_descr
|
||||
|
||||
subroutine d_rkr_solver_cnv(sv,info,amold,vmold,imold)
|
||||
subroutine d_krm_solver_cnv(sv,info,amold,vmold,imold)
|
||||
implicit none
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_d_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
@@ -490,13 +494,13 @@ contains
|
||||
|
||||
call sv%prec%cnv(info,amold=amold,vmold=vmold,imold=imold)
|
||||
|
||||
end subroutine d_rkr_solver_cnv
|
||||
end subroutine d_krm_solver_cnv
|
||||
|
||||
subroutine d_rkr_solver_clone(sv,svout,info)
|
||||
subroutine d_krm_solver_clone(sv,svout,info)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -505,7 +509,7 @@ contains
|
||||
call svout%free(info)
|
||||
allocate(svout,stat=info,mold=sv)
|
||||
select type(so=>svout)
|
||||
class is(amg_d_rkr_solver_type)
|
||||
class is(amg_d_krm_solver_type)
|
||||
so%method = sv%method
|
||||
so%kprec = sv%kprec
|
||||
so%sub_solve = sv%sub_solve
|
||||
@@ -524,21 +528,21 @@ contains
|
||||
info = psb_err_internal_error_
|
||||
end select
|
||||
|
||||
end subroutine d_rkr_solver_clone
|
||||
end subroutine d_krm_solver_clone
|
||||
|
||||
|
||||
subroutine d_rkr_solver_clone_settings(sv,svout,info)
|
||||
subroutine d_krm_solver_clone_settings(sv,svout,info)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_d_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_d_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select type(so=>svout)
|
||||
class is(amg_d_rkr_solver_type)
|
||||
class is(amg_d_krm_solver_type)
|
||||
so%method = sv%method
|
||||
so%kprec = sv%kprec
|
||||
so%sub_solve = sv%sub_solve
|
||||
@@ -554,11 +558,11 @@ contains
|
||||
info = psb_err_internal_error_
|
||||
end select
|
||||
|
||||
end subroutine d_rkr_solver_clone_settings
|
||||
end subroutine d_krm_solver_clone_settings
|
||||
|
||||
subroutine d_rkr_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
|
||||
subroutine d_krm_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
|
||||
implicit none
|
||||
class(amg_d_rkr_solver_type), intent(in) :: sv
|
||||
class(amg_d_krm_solver_type), intent(in) :: sv
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -568,23 +572,23 @@ contains
|
||||
|
||||
call sv%prec%dump(info,prefix=prefix,head=head)
|
||||
|
||||
end subroutine d_rkr_solver_dmp
|
||||
end subroutine d_krm_solver_dmp
|
||||
!
|
||||
! Notify whether RKR is used as a global solver
|
||||
! Notify whether KRM is used as a global solver
|
||||
!
|
||||
function d_rkr_solver_is_global(sv) result(val)
|
||||
function d_krm_solver_is_global(sv) result(val)
|
||||
implicit none
|
||||
class(amg_d_rkr_solver_type), intent(in) :: sv
|
||||
class(amg_d_krm_solver_type), intent(in) :: sv
|
||||
logical :: val
|
||||
|
||||
val = (sv%global)
|
||||
end function d_rkr_solver_is_global
|
||||
end function d_krm_solver_is_global
|
||||
!
|
||||
function d_rkr_solver_is_iterative() result(val)
|
||||
function d_krm_solver_is_iterative() result(val)
|
||||
implicit none
|
||||
logical :: val
|
||||
|
||||
val = .true.
|
||||
end function d_rkr_solver_is_iterative
|
||||
end function d_krm_solver_is_iterative
|
||||
|
||||
end module amg_d_rkr_solver
|
||||
end module amg_d_krm_solver
|
||||
File diff suppressed because it is too large
Load Diff
@@ -3,9 +3,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -78,7 +78,8 @@ module amg_d_mumps_solver
|
||||
!
|
||||
! Controls to be set before MUMPS instantiation:
|
||||
!
|
||||
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: LOCAL 1==amg_global_solver_: GLOBAL
|
||||
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: 'LOCAL_SOLVER
|
||||
! 1==amg_global_solver_: 'GLOBAL_SOLVER'
|
||||
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
|
||||
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
|
||||
integer(psb_ipk_), dimension(3) :: ipar
|
||||
@@ -313,22 +314,24 @@ subroutine d_mumps_solver_finalize(sv)
|
||||
|
||||
end subroutine d_mumps_solver_finalize
|
||||
|
||||
subroutine d_mumps_solver_descr(sv,info,iout,coarse)
|
||||
subroutine d_mumps_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_mumps_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: me, np
|
||||
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -337,8 +340,13 @@ subroutine d_mumps_solver_descr(sv,info,iout,coarse)
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) ' MUMPS Solver. '
|
||||
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
+336
-164
@@ -1,15 +1,15 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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:
|
||||
@@ -21,7 +21,7 @@
|
||||
! 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
|
||||
@@ -33,22 +33,22 @@
|
||||
! 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.
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! File: amg_d_onelev_mod.f90
|
||||
!
|
||||
! Module: amg_d_onelev_mod
|
||||
!
|
||||
! This module defines:
|
||||
! This module defines:
|
||||
! - the amg_d_onelev_type data structure containing one level
|
||||
! of a multilevel preconditioner and related
|
||||
! data structures;
|
||||
!
|
||||
! It contains routines for
|
||||
! - Building and applying;
|
||||
! - Building and applying;
|
||||
! - checking if the preconditioner is correctly defined;
|
||||
! - printing a description of the preconditioner;
|
||||
! - deallocating the preconditioner data structure.
|
||||
! - deallocating the preconditioner data structure.
|
||||
!
|
||||
|
||||
module amg_d_onelev_mod
|
||||
@@ -56,6 +56,8 @@ module amg_d_onelev_mod
|
||||
use amg_base_prec_type
|
||||
use amg_d_base_smoother_mod
|
||||
use amg_d_dec_aggregator_mod
|
||||
use amg_d_parmatch_aggregator_mod
|
||||
|
||||
use psb_base_mod, only : psb_dspmat_type, psb_d_vect_type, &
|
||||
& psb_d_base_vect_type, psb_ldspmat_type, psb_dlinmap_type, psb_dpk_, &
|
||||
& psb_ipk_, psb_epk_, psb_lpk_, psb_desc_type, psb_i_base_vect_type, &
|
||||
@@ -73,16 +75,16 @@ module amg_d_onelev_mod
|
||||
! class(amg_d_base_smoother_type), pointer :: sm2 => null()
|
||||
! class(amg_dmlprec_wrk_type), allocatable :: wrk
|
||||
! class(amg_d_base_aggregator_type), allocatable :: aggr
|
||||
! type(amg_dml_parms) :: parms
|
||||
! type(amg_dml_parms) :: parms
|
||||
! type(psb_dspmat_type) :: ac
|
||||
! type(psb_desc_type) :: desc_ac
|
||||
! type(psb_dspmat_type), pointer :: base_a => null()
|
||||
! type(psb_desc_type), pointer :: base_desc => null()
|
||||
! type(psb_dspmat_type), pointer :: base_a => null()
|
||||
! type(psb_desc_type), pointer :: base_desc => null()
|
||||
! type(psb_dlinmap_type) :: map
|
||||
! end type amg_donelev_type
|
||||
!
|
||||
! Note that d denotes the kind of the real data type to be chosen
|
||||
! according to single/double precision version of MLD2P4.
|
||||
! according to single/double precision version of AMG4PSBLAS.
|
||||
!
|
||||
! sm,sm2a - class(amg_d_base_smoother_type), allocatable
|
||||
! The current level pre- and post-smooother.
|
||||
@@ -93,7 +95,7 @@ module amg_d_onelev_mod
|
||||
! Workspace for application of preconditioner; may be
|
||||
! pre-allocated to save time in the application within a
|
||||
! Krylov solver.
|
||||
! aggr - class(amg_d_base_aggregator_type), allocatable
|
||||
! aggr - class(amg_d_base_aggregator_type), allocatable
|
||||
! The aggregator object: holds the algorithmic choices and
|
||||
! (possibly) additional data for building the aggregation.
|
||||
! parms - type(amg_dml_parms)
|
||||
@@ -104,7 +106,7 @@ module amg_d_onelev_mod
|
||||
! The communication descriptor associated to the matrix
|
||||
! stored in ac.
|
||||
! base_a - type(psb_dspmat_type), pointer.
|
||||
! Pointer (really a pointer!) to the local part of the current
|
||||
! 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.
|
||||
@@ -115,13 +117,13 @@ module amg_d_onelev_mod
|
||||
! vector spaces associated to the index spaces of the previous
|
||||
! and current levels.
|
||||
!
|
||||
! Methods:
|
||||
! 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.
|
||||
! then calls the descr() method of the smoother object.
|
||||
!
|
||||
! descr - Prints a description of the object.
|
||||
! default - Set default values
|
||||
@@ -130,14 +132,14 @@ module amg_d_onelev_mod
|
||||
! it is passed to the smoother object for further processing.
|
||||
! check - Sanity checks.
|
||||
! sizeof - Total memory occupation in bytes
|
||||
! get_nzeros - Number of nonzeros
|
||||
! get_nzeros - Number of nonzeros
|
||||
! get_wrksz - How many workspace vector does apply_vect need
|
||||
! allocate_wrk - Allocate auxiliary workspace
|
||||
! free_wrk - Free auxiliary workspace
|
||||
! bld_tprol - Invoke the aggr method to build the tentative prolongator
|
||||
! mat_asb - Build the final (possibly smoothed) prolongator and coarse matrix.
|
||||
! mat_asb - Build the final (possibly smoothed) prolongator and coarse matrix.
|
||||
!
|
||||
!
|
||||
!
|
||||
type amg_dmlprec_wrk_type
|
||||
real(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
|
||||
type(psb_d_vect_type) :: vtx, vty, vx2l, vy2l
|
||||
@@ -148,25 +150,35 @@ module amg_d_onelev_mod
|
||||
procedure, pass(wk) :: clone => d_wrk_clone
|
||||
procedure, pass(wk) :: move_alloc => d_wrk_move_alloc
|
||||
procedure, pass(wk) :: cnv => d_wrk_cnv
|
||||
procedure, pass(wk) :: sizeof => d_wrk_sizeof
|
||||
procedure, pass(wk) :: sizeof => d_wrk_sizeof
|
||||
end type amg_dmlprec_wrk_type
|
||||
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
|
||||
|
||||
type amg_d_remap_data_type
|
||||
type(psb_dspmat_type) :: ac_pre_remap
|
||||
type(psb_desc_type) :: desc_ac_pre_remap
|
||||
integer(psb_ipk_) :: idest
|
||||
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
|
||||
contains
|
||||
procedure, pass(rmp) :: clone => d_remap_data_clone
|
||||
end type amg_d_remap_data_type
|
||||
|
||||
type amg_d_onelev_type
|
||||
class(amg_d_base_smoother_type), allocatable :: sm, sm2a
|
||||
class(amg_d_base_smoother_type), pointer :: sm2 => null()
|
||||
class(amg_dmlprec_wrk_type), allocatable :: wrk
|
||||
class(amg_d_base_aggregator_type), allocatable :: aggr
|
||||
type(amg_dml_parms) :: parms
|
||||
type(amg_dml_parms) :: parms
|
||||
type(psb_dspmat_type) :: ac
|
||||
integer(psb_ipk_) :: ac_nz_loc
|
||||
integer(psb_lpk_) :: ac_nz_tot
|
||||
type(psb_desc_type) :: desc_ac
|
||||
type(psb_dspmat_type), pointer :: base_a => null()
|
||||
type(psb_desc_type), pointer :: base_desc => null()
|
||||
type(psb_dspmat_type), pointer :: base_a => null()
|
||||
type(psb_desc_type), pointer :: base_desc => null()
|
||||
type(psb_ldspmat_type) :: tprol
|
||||
type(psb_dlinmap_type) :: map
|
||||
type(psb_dlinmap_type) :: linmap
|
||||
type(amg_d_remap_data_type) :: remap_data
|
||||
real(psb_dpk_) :: szratio
|
||||
contains
|
||||
procedure, pass(lv) :: bld_tprol => d_base_onelev_bld_tprol
|
||||
@@ -176,8 +188,10 @@ module amg_d_onelev_mod
|
||||
procedure, pass(lv) :: clone => d_base_onelev_clone
|
||||
procedure, pass(lv) :: cnv => amg_d_base_onelev_cnv
|
||||
procedure, pass(lv) :: descr => amg_d_base_onelev_descr
|
||||
procedure, pass(lv) :: memory_use => amg_d_base_onelev_memory_use
|
||||
procedure, pass(lv) :: default => d_base_onelev_default
|
||||
procedure, pass(lv) :: free => amg_d_base_onelev_free
|
||||
procedure, pass(lv) :: free_smoothers => amg_d_base_onelev_free_smoothers
|
||||
procedure, pass(lv) :: nullify => d_base_onelev_nullify
|
||||
procedure, pass(lv) :: check => amg_d_base_onelev_check
|
||||
procedure, pass(lv) :: dump => amg_d_base_onelev_dump
|
||||
@@ -187,7 +201,7 @@ module amg_d_onelev_mod
|
||||
procedure, pass(lv) :: setsm => amg_d_base_onelev_setsm
|
||||
procedure, pass(lv) :: setsv => amg_d_base_onelev_setsv
|
||||
procedure, pass(lv) :: setag => amg_d_base_onelev_setag
|
||||
generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag
|
||||
generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag
|
||||
procedure, pass(lv) :: sizeof => d_base_onelev_sizeof
|
||||
procedure, pass(lv) :: get_nzeros => d_base_onelev_get_nzeros
|
||||
procedure, pass(lv) :: get_wrksz => d_base_onelev_get_wrksize
|
||||
@@ -195,7 +209,14 @@ module amg_d_onelev_mod
|
||||
procedure, pass(lv) :: free_wrk => d_base_onelev_free_wrk
|
||||
procedure, nopass :: stringval => amg_stringval
|
||||
procedure, pass(lv) :: move_alloc => d_base_onelev_move_alloc
|
||||
|
||||
|
||||
|
||||
procedure, pass(lv) :: map_rstr_a => amg_d_base_onelev_map_rstr_a
|
||||
procedure, pass(lv) :: map_prol_a => amg_d_base_onelev_map_prol_a
|
||||
procedure, pass(lv) :: map_rstr_v => amg_d_base_onelev_map_rstr_v
|
||||
procedure, pass(lv) :: map_prol_v => amg_d_base_onelev_map_prol_v
|
||||
generic, public :: map_rstr => map_rstr_a, map_rstr_v
|
||||
generic, public :: map_prol => map_prol_a, map_prol_v
|
||||
end type amg_d_onelev_type
|
||||
|
||||
type amg_d_onelev_node
|
||||
@@ -209,11 +230,11 @@ module amg_d_onelev_mod
|
||||
& d_base_onelev_get_wrksize, d_base_onelev_allocate_wrk, &
|
||||
& d_base_onelev_free_wrk
|
||||
|
||||
interface
|
||||
interface
|
||||
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
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
@@ -238,141 +259,172 @@ module amg_d_onelev_mod
|
||||
end subroutine amg_d_base_onelev_build
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout)
|
||||
interface
|
||||
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
|
||||
! Arguments
|
||||
class(amg_d_onelev_type), intent(in) :: lv
|
||||
integer(psb_ipk_), intent(in) :: il,nl,ilmin
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
class(amg_d_onelev_type), intent(in) :: lv
|
||||
integer(psb_ipk_), intent(in) :: il,nl,ilmin
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_d_base_onelev_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
interface
|
||||
subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
|
||||
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
|
||||
! Arguments
|
||||
class(amg_d_onelev_type), intent(in) :: lv
|
||||
integer(psb_ipk_), intent(in) :: il,nl,ilmin
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: global
|
||||
end subroutine amg_d_base_onelev_memory_use
|
||||
end interface
|
||||
|
||||
interface
|
||||
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
|
||||
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_base_onelev_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_base_onelev_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
class(amg_d_onelev_type), intent(inout) :: lv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_base_onelev_free_smoothers
|
||||
end interface
|
||||
|
||||
interface
|
||||
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
|
||||
! Arguments
|
||||
class(amg_d_onelev_type), intent(inout) :: lv
|
||||
class(amg_d_onelev_type), intent(inout) :: lv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_base_onelev_check
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
|
||||
! 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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
end subroutine amg_d_base_onelev_setsm
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
|
||||
! 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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
end subroutine amg_d_base_onelev_setsv
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
|
||||
! 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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
end subroutine amg_d_base_onelev_setag
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
|
||||
! Arguments
|
||||
class(amg_d_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
class(amg_d_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_d_base_onelev_cseti
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
! Arguments
|
||||
class(amg_d_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
class(amg_d_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_d_base_onelev_csetc
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
class(amg_d_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
|
||||
class(amg_d_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
@@ -380,13 +432,13 @@ interface
|
||||
end subroutine amg_d_base_onelev_csetr
|
||||
end interface
|
||||
|
||||
interface
|
||||
interface
|
||||
subroutine amg_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
|
||||
& 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
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -394,15 +446,62 @@ interface
|
||||
logical, optional, intent(in) :: ac, rp, smoother, solver, tprol, global_num
|
||||
end subroutine amg_d_base_onelev_dump
|
||||
end interface
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_d_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
|
||||
import
|
||||
implicit none
|
||||
class(amg_d_onelev_type), target, intent(inout) :: lv
|
||||
real(psb_dpk_), intent(in) :: alpha, beta
|
||||
real(psb_dpk_), intent(inout) :: u(:)
|
||||
real(psb_dpk_), intent(out) :: v(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_dpk_), optional :: work(:)
|
||||
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)
|
||||
import
|
||||
implicit none
|
||||
class(amg_d_onelev_type), target, intent(inout) :: lv
|
||||
real(psb_dpk_), intent(in) :: alpha, beta
|
||||
type(psb_d_vect_type), intent(inout) :: vect_u, vect_v
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_dpk_), optional :: work(:)
|
||||
type(psb_d_vect_type), optional, target, intent(inout) :: vtx,vty
|
||||
end subroutine amg_d_base_onelev_map_rstr_v
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
|
||||
import
|
||||
implicit none
|
||||
class(amg_d_onelev_type), target, intent(inout) :: lv
|
||||
real(psb_dpk_), intent(in) :: alpha, beta
|
||||
real(psb_dpk_), intent(inout) :: u(:)
|
||||
real(psb_dpk_), intent(out) :: v(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_dpk_), optional :: work(:)
|
||||
|
||||
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)
|
||||
import
|
||||
implicit none
|
||||
class(amg_d_onelev_type), target, intent(inout) :: lv
|
||||
real(psb_dpk_), intent(in) :: alpha, beta
|
||||
type(psb_d_vect_type), intent(inout) :: vect_u, vect_v
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_dpk_), optional :: work(:)
|
||||
type(psb_d_vect_type), optional, target, intent(inout) :: vtx,vty
|
||||
end subroutine amg_d_base_onelev_map_prol_v
|
||||
end interface
|
||||
|
||||
contains
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
|
||||
function d_base_onelev_get_nzeros(lv) result(val)
|
||||
implicit none
|
||||
implicit none
|
||||
class(amg_d_onelev_type), intent(in) :: lv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
@@ -414,16 +513,16 @@ contains
|
||||
end function d_base_onelev_get_nzeros
|
||||
|
||||
function d_base_onelev_sizeof(lv) result(val)
|
||||
implicit none
|
||||
implicit none
|
||||
class(amg_d_onelev_type), intent(in) :: lv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
|
||||
val = psb_sizeof_ip+psb_sizeof_lp
|
||||
val = val + lv%desc_ac%sizeof()
|
||||
val = val + lv%ac%sizeof()
|
||||
val = val + lv%tprol%sizeof()
|
||||
val = val + lv%map%sizeof()
|
||||
val = val + lv%linmap%sizeof()
|
||||
if (allocated(lv%sm)) val = val + lv%sm%sizeof()
|
||||
if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof()
|
||||
if (allocated(lv%aggr)) val = val + lv%aggr%sizeof()
|
||||
@@ -432,19 +531,19 @@ contains
|
||||
|
||||
|
||||
subroutine d_base_onelev_nullify(lv)
|
||||
implicit none
|
||||
implicit none
|
||||
|
||||
class(amg_d_onelev_type), intent(inout) :: lv
|
||||
|
||||
nullify(lv%base_a)
|
||||
nullify(lv%base_desc)
|
||||
nullify(lv%base_a)
|
||||
nullify(lv%base_desc)
|
||||
nullify(lv%sm2)
|
||||
end subroutine d_base_onelev_nullify
|
||||
|
||||
!
|
||||
! Multilevel defaults:
|
||||
! Multilevel defaults:
|
||||
! multiplicative vs. additive ML framework;
|
||||
! Smoothed decoupled aggregation with zero threshold;
|
||||
! Smoothed decoupled aggregation with zero threshold;
|
||||
! distributed coarse matrix;
|
||||
! damping omega computed with the max-norm estimate of the
|
||||
! dominant eigenvalue;
|
||||
@@ -454,10 +553,10 @@ contains
|
||||
subroutine d_base_onelev_default(lv)
|
||||
|
||||
Implicit None
|
||||
|
||||
|
||||
! Arguments
|
||||
class(amg_d_onelev_type), target, intent(inout) :: lv
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
lv%parms%sweeps_pre = 1
|
||||
lv%parms%sweeps_post = 1
|
||||
@@ -472,7 +571,7 @@ contains
|
||||
lv%parms%aggr_filter = amg_no_filter_mat_
|
||||
lv%parms%aggr_omega_val = dzero
|
||||
lv%parms%aggr_thresh = 0.01_psb_dpk_
|
||||
|
||||
|
||||
if (allocated(lv%sm)) call lv%sm%default()
|
||||
if (allocated(lv%sm2a)) then
|
||||
call lv%sm2a%default()
|
||||
@@ -482,7 +581,7 @@ contains
|
||||
end if
|
||||
if (.not.allocated(lv%aggr)) allocate(amg_d_dec_aggregator_type :: lv%aggr,stat=info)
|
||||
if (allocated(lv%aggr)) call lv%aggr%default()
|
||||
|
||||
|
||||
return
|
||||
|
||||
end subroutine d_base_onelev_default
|
||||
@@ -497,9 +596,9 @@ contains
|
||||
type(psb_ldspmat_type), intent(out) :: t_prol
|
||||
type(amg_daggr_data), intent(in) :: ag_data
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
call lv%aggr%bld_tprol(lv%parms,ag_data,a,desc_a,ilaggr,nlaggr,t_prol,info)
|
||||
|
||||
|
||||
end subroutine d_base_onelev_bld_tprol
|
||||
|
||||
|
||||
@@ -509,7 +608,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
call lv%aggr%update_next(lvnext%aggr,info)
|
||||
|
||||
|
||||
end subroutine d_base_onelev_update_aggr
|
||||
|
||||
|
||||
@@ -518,33 +617,33 @@ contains
|
||||
Implicit None
|
||||
|
||||
! 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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(lv%sm)) then
|
||||
if (allocated(lv%sm)) then
|
||||
call lv%sm%clone(lvout%sm,info)
|
||||
else
|
||||
if (allocated(lvout%sm)) then
|
||||
else
|
||||
if (allocated(lvout%sm)) then
|
||||
call lvout%sm%free(info)
|
||||
if (info==psb_success_) deallocate(lvout%sm,stat=info)
|
||||
end if
|
||||
end if
|
||||
if (allocated(lv%sm2a)) then
|
||||
if (allocated(lv%sm2a)) then
|
||||
call lv%sm%clone(lvout%sm2a,info)
|
||||
lvout%sm2 => lvout%sm2a
|
||||
else
|
||||
if (allocated(lvout%sm2a)) then
|
||||
else
|
||||
if (allocated(lvout%sm2a)) then
|
||||
call lvout%sm2a%free(info)
|
||||
if (info==psb_success_) deallocate(lvout%sm2a,stat=info)
|
||||
end if
|
||||
lvout%sm2 => lvout%sm
|
||||
end if
|
||||
if (allocated(lv%aggr)) then
|
||||
if (allocated(lv%aggr)) then
|
||||
call lv%aggr%clone(lvout%aggr,info)
|
||||
else
|
||||
if (allocated(lvout%aggr)) then
|
||||
if (allocated(lvout%aggr)) then
|
||||
call lvout%aggr%free(info)
|
||||
if (info==psb_success_) deallocate(lvout%aggr,stat=info)
|
||||
end if
|
||||
@@ -553,10 +652,11 @@ contains
|
||||
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
|
||||
if (info == psb_success_) call lv%tprol%clone(lvout%tprol,info)
|
||||
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
|
||||
if (info == psb_success_) call lv%map%clone(lvout%map,info)
|
||||
if (info == psb_success_) call lv%linmap%clone(lvout%linmap,info)
|
||||
if (info == psb_success_) call lv%remap_data%clone(lvout%remap_data,info)
|
||||
lvout%base_a => lv%base_a
|
||||
lvout%base_desc => lv%base_desc
|
||||
|
||||
|
||||
return
|
||||
|
||||
end subroutine d_base_onelev_clone
|
||||
@@ -565,12 +665,12 @@ contains
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(amg_d_onelev_type), target, intent(inout) :: lv, b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
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
|
||||
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
|
||||
@@ -581,18 +681,18 @@ contains
|
||||
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%map,b%map,info)
|
||||
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)
|
||||
implicit none
|
||||
implicit none
|
||||
class(amg_d_onelev_type), intent(inout) :: lv
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
@@ -613,44 +713,54 @@ contains
|
||||
select case(lv%parms%ml_cycle)
|
||||
case(amg_add_ml_,amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
|
||||
! We're good
|
||||
|
||||
|
||||
case(amg_kcycle_ml_, amg_kcyclesym_ml_)
|
||||
!
|
||||
! We need 7 in inneritkcycle.
|
||||
! Can we reuse vtx?
|
||||
!
|
||||
! Can we reuse vtx?
|
||||
!
|
||||
val = val + 7
|
||||
|
||||
|
||||
case default
|
||||
! Need a better error signaling ?
|
||||
val = -1
|
||||
end select
|
||||
|
||||
|
||||
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
|
||||
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) call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
|
||||
|
||||
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_), intent(out) :: info
|
||||
!
|
||||
integer(psb_ipk_) :: nwv,i
|
||||
integer(psb_ipk_) :: nwv,i
|
||||
info = psb_success_
|
||||
|
||||
if (allocated(lv%wrk)) then
|
||||
@@ -658,46 +768,88 @@ contains
|
||||
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)
|
||||
|
||||
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
|
||||
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)
|
||||
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,&
|
||||
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)
|
||||
end do
|
||||
|
||||
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_), intent(out) :: info
|
||||
!
|
||||
integer(psb_ipk_) :: i
|
||||
info = psb_success_
|
||||
@@ -718,7 +870,7 @@ contains
|
||||
end if
|
||||
|
||||
end subroutine d_wrk_free
|
||||
|
||||
|
||||
subroutine d_wrk_clone(wk,wkout,info)
|
||||
use psb_base_mod
|
||||
Implicit None
|
||||
@@ -726,11 +878,11 @@ contains
|
||||
! 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_), 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)
|
||||
@@ -752,12 +904,12 @@ contains
|
||||
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
|
||||
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
call b%free(info)
|
||||
call move_alloc(wk%tx,b%tx)
|
||||
call move_alloc(wk%ty,b%ty)
|
||||
@@ -770,17 +922,17 @@ contains
|
||||
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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_d_base_vect_type), intent(in), optional :: vmold
|
||||
!
|
||||
integer(psb_ipk_) :: i
|
||||
@@ -801,7 +953,7 @@ contains
|
||||
|
||||
function d_wrk_sizeof(wk) result(val)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
implicit none
|
||||
class(amg_dmlprec_wrk_type), intent(in) :: wk
|
||||
integer(psb_epk_) :: val
|
||||
integer :: i
|
||||
@@ -820,5 +972,25 @@ contains
|
||||
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
|
||||
|
||||
@@ -0,0 +1,691 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
! moved here from amg4psblas-extension
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS Extensions
|
||||
!
|
||||
! (C) Copyright 2019
|
||||
!
|
||||
! Salvatore Filippone Cranfield University
|
||||
! Pasqua D'Ambra IAC-CNR, Naples, IT
|
||||
!
|
||||
! 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
|
||||
!
|
||||
!
|
||||
! 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
|
||||
!
|
||||
!
|
||||
|
||||
module amg_d_parmatch_aggregator_mod
|
||||
use amg_d_base_aggregator_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
|
||||
integer(psb_ipk_) :: matching_alg
|
||||
integer(psb_ipk_) :: n_sweeps ! When n_sweeps >1 we need an auxiliary descriptor
|
||||
integer(psb_ipk_) :: orig_aggr_size
|
||||
integer(psb_ipk_) :: jacobi_sweeps
|
||||
real(psb_dpk_), allocatable :: w(:), w_nxt(:)
|
||||
type(psb_dspmat_type), allocatable :: prol, restr
|
||||
type(psb_dspmat_type), allocatable :: ac, base_a, rwa
|
||||
type(psb_desc_type), allocatable :: desc_ac, desc_ax, base_desc, rwdesc
|
||||
logical :: reproducible_matching = .false.
|
||||
logical :: need_symmetrize = .false.
|
||||
logical :: unsmoothed_hierarchy = .true.
|
||||
contains
|
||||
procedure, pass(ag) :: bld_tprol => amg_d_parmatch_aggregator_build_tprol
|
||||
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) :: inner_mat_asb => amg_d_parmatch_aggregator_inner_mat_asb
|
||||
procedure, pass(ag) :: bld_map => amg_d_parmatch_aggregator_bld_map
|
||||
procedure, pass(ag) :: csetc => amg_d_parmatch_aggr_csetc
|
||||
procedure, pass(ag) :: cseti => amg_d_parmatch_aggr_cseti
|
||||
procedure, pass(ag) :: default => amg_d_parmatch_aggr_set_default
|
||||
procedure, pass(ag) :: sizeof => amg_d_parmatch_aggregator_sizeof
|
||||
procedure, pass(ag) :: update_next => amg_d_parmatch_aggregator_update_next
|
||||
procedure, pass(ag) :: bld_wnxt => amg_d_parmatch_bld_wnxt
|
||||
procedure, pass(ag) :: bld_default_w => amg_d_bld_default_w
|
||||
procedure, pass(ag) :: set_c_default_w => amg_d_set_prm_c_default_w
|
||||
procedure, pass(ag) :: descr => amg_d_parmatch_aggregator_descr
|
||||
procedure, pass(ag) :: clone => amg_d_parmatch_aggregator_clone
|
||||
procedure, pass(ag) :: free => amg_d_parmatch_aggregator_free
|
||||
procedure, nopass :: fmt => amg_d_parmatch_aggregator_fmt
|
||||
procedure, nopass :: xt_desc => amg_d_parmatch_aggregator_xt_desc
|
||||
end type amg_d_parmatch_aggregator_type
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
& a,desc_a,ilaggr,nlaggr,t_prol,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(amg_daggr_data), intent(in) :: ag_data
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
|
||||
type(psb_ldspmat_type), intent(out) :: t_prol
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_aggregator_build_tprol
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
|
||||
implicit none
|
||||
class(amg_d_parmatch_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(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(psb_ldspmat_type), intent(inout) :: t_prol
|
||||
type(psb_dspmat_type), intent(out) :: op_prol,ac,op_restr
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_aggregator_mat_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
|
||||
& ac,desc_ac, op_prol,op_restr,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
|
||||
implicit none
|
||||
class(amg_d_parmatch_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(inout) :: desc_a
|
||||
type(psb_dspmat_type), intent(inout) :: op_prol,ac,op_restr
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_aggregator_mat_asb
|
||||
end interface
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
|
||||
& ac,desc_ac, op_prol,op_restr,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
|
||||
implicit none
|
||||
class(amg_d_parmatch_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
|
||||
type(psb_dspmat_type), intent(inout) :: op_prol,op_restr
|
||||
type(psb_dspmat_type), intent(inout) :: ac
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_aggregator_inner_mat_asb
|
||||
end interface
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_spmm_bld(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_ldspmat_type), intent(inout) :: t_prol
|
||||
type(psb_dspmat_type), intent(inout) :: ac, op_prol, op_restr
|
||||
type(psb_desc_type), intent(out) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_spmm_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_unsmth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: dol1smoothing
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_ldspmat_type), intent(inout) :: t_prol
|
||||
type(psb_dspmat_type), intent(inout) :: op_prol,ac, op_restr
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_unsmth_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: dol1smoothing
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(psb_dspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_ldspmat_type), intent(inout) :: t_prol
|
||||
type(psb_dspmat_type), intent(inout) :: op_prol,ac, op_restr
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_smth_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data
|
||||
implicit none
|
||||
type(psb_dspmat_type), intent(inout) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_ldspmat_type), intent(inout) :: t_prol
|
||||
type(psb_dspmat_type), intent(inout) :: op_prol,ac, op_restr
|
||||
type(psb_desc_type), intent(out) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_spmm_bld_ov
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_parmatch_spmm_bld_inner(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_d_parmatch_aggregator_type, psb_desc_type, psb_dspmat_type,&
|
||||
& psb_ldspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_dml_parms, amg_daggr_data,&
|
||||
& psb_d_csr_sparse_mat, psb_ld_csr_sparse_mat
|
||||
implicit none
|
||||
type(psb_d_csr_sparse_mat), intent(inout) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_ldspmat_type), intent(inout) :: t_prol
|
||||
type(psb_dspmat_type), intent(inout) :: op_prol,ac, op_restr
|
||||
type(psb_desc_type), intent(out) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_parmatch_spmm_bld_inner
|
||||
end interface
|
||||
|
||||
private :: is_legal_malg, is_legal_csize, is_legal_nsweeps, is_legal_nlevels
|
||||
|
||||
contains
|
||||
|
||||
subroutine amg_d_bld_default_w(ag,nr)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
integer(psb_ipk_), intent(in) :: nr
|
||||
integer(psb_ipk_) :: info
|
||||
call psb_realloc(nr,ag%w,info)
|
||||
if (info /= psb_success_) return
|
||||
ag%w = done
|
||||
!call ag%set_c_default_w()
|
||||
end subroutine amg_d_bld_default_w
|
||||
|
||||
subroutine amg_d_set_prm_c_default_w(ag)
|
||||
use psb_realloc_mod
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
!write(0,*) 'prm_c_deafult_w '
|
||||
call psb_safe_ab_cpy(ag%w,ag%w_nxt,info)
|
||||
|
||||
end subroutine amg_d_set_prm_c_default_w
|
||||
|
||||
subroutine amg_d_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
integer(psb_lpk_), intent(in) :: ilaggr(:)
|
||||
real(psb_dpk_), intent(in) :: valaggr(:)
|
||||
integer(psb_ipk_), intent(in) :: nx
|
||||
|
||||
integer(psb_ipk_) :: info,i,j
|
||||
|
||||
! The vector was already fixed in the call to BCMatch.
|
||||
!write(0,*) 'Executing bld_wnxt ',nx
|
||||
call psb_realloc(nx,ag%w_nxt,info)
|
||||
|
||||
end subroutine amg_d_parmatch_bld_wnxt
|
||||
|
||||
function amg_d_parmatch_aggregator_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Parallel Matching aggregation"
|
||||
end function amg_d_parmatch_aggregator_fmt
|
||||
|
||||
function amg_d_parmatch_aggregator_xt_desc() result(val)
|
||||
implicit none
|
||||
logical :: val
|
||||
|
||||
val = .true.
|
||||
end function amg_d_parmatch_aggregator_xt_desc
|
||||
|
||||
function amg_d_parmatch_aggregator_sizeof(ag) result(val)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), intent(in) :: ag
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = 4
|
||||
val = val + psb_size(ag%w) + psb_size(ag%w_nxt)
|
||||
if (allocated(ag%ac)) val = val + ag%ac%sizeof()
|
||||
if (allocated(ag%base_a)) val = val + ag%base_a%sizeof()
|
||||
if (allocated(ag%prol)) val = val + ag%prol%sizeof()
|
||||
if (allocated(ag%restr)) val = val + ag%restr%sizeof()
|
||||
if (allocated(ag%desc_ac)) val = val + ag%desc_ac%sizeof()
|
||||
if (allocated(ag%base_desc)) val = val + ag%base_desc%sizeof()
|
||||
if (allocated(ag%desc_ax)) val = val + ag%desc_ax%sizeof()
|
||||
|
||||
end function amg_d_parmatch_aggregator_sizeof
|
||||
|
||||
subroutine amg_d_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), intent(in) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator'
|
||||
write(iout,*) trim(prefix_),' ',' Number of matching sweeps: ',ag%n_sweeps
|
||||
write(iout,*) trim(prefix_),' ',' Matching algorithm : MatchBoxP (PREIS)'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
|
||||
return
|
||||
end subroutine amg_d_parmatch_aggregator_descr
|
||||
|
||||
function is_legal_malg(alg) result(val)
|
||||
logical :: val
|
||||
integer(psb_ipk_) :: alg
|
||||
|
||||
val = (0==alg)
|
||||
end function is_legal_malg
|
||||
|
||||
function is_legal_csize(csize) result(val)
|
||||
logical :: val
|
||||
integer(psb_ipk_) :: csize
|
||||
|
||||
val = ((-1==csize).or.(csize >0))
|
||||
end function is_legal_csize
|
||||
|
||||
function is_legal_nsweeps(nsw) result(val)
|
||||
logical :: val
|
||||
integer(psb_ipk_) :: nsw
|
||||
|
||||
val = (1<=nsw)
|
||||
end function is_legal_nsweeps
|
||||
|
||||
function is_legal_nlevels(nlv) result(val)
|
||||
logical :: val
|
||||
integer(psb_ipk_) :: nlv
|
||||
|
||||
val = (1<=nlv)
|
||||
end function is_legal_nlevels
|
||||
|
||||
|
||||
subroutine amg_d_parmatch_aggregator_update_next(ag,agnext,info)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
class(amg_d_base_aggregator_type), target, intent(inout) :: agnext
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!
|
||||
!
|
||||
select type(agnext)
|
||||
class is (amg_d_parmatch_aggregator_type)
|
||||
if (.not.is_legal_malg(agnext%matching_alg)) &
|
||||
& agnext%matching_alg = ag%matching_alg
|
||||
if (.not.is_legal_nsweeps(agnext%n_sweeps))&
|
||||
& agnext%n_sweeps = ag%n_sweeps
|
||||
!!$ if (.not.is_legal_csize(agnext%max_csize))&
|
||||
!!$ & agnext%max_csize = ag%max_csize
|
||||
!!$ if (.not.is_legal_nlevels(agnext%max_nlevels))&
|
||||
!!$ & agnext%max_nlevels = ag%max_nlevels
|
||||
! Is this going to generate shallow copies/memory leaks/double frees?
|
||||
! To be investigated further.
|
||||
call psb_safe_ab_cpy(ag%w_nxt,agnext%w,info)
|
||||
call agnext%set_c_default_w()
|
||||
if (ag%unsmoothed_hierarchy) then
|
||||
agnext%unsmoothed_hierarchy = .true.
|
||||
call move_alloc(ag%rwdesc,agnext%base_desc)
|
||||
call move_alloc(ag%rwa,agnext%base_a)
|
||||
end if
|
||||
|
||||
class default
|
||||
! What should we do here?
|
||||
end select
|
||||
info = 0
|
||||
end subroutine amg_d_parmatch_aggregator_update_next
|
||||
|
||||
subroutine amg_d_parmatch_aggr_csetc(ag,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, iwhat
|
||||
character(len=20) :: name='d_parmatch_aggr_cseti'
|
||||
info = psb_success_
|
||||
|
||||
! For now we ignore IDX
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('PRMC_REPRODUCIBLE_MATCHING')
|
||||
select case(psb_toupper(trim(val)))
|
||||
case('F','FALSE')
|
||||
ag%reproducible_matching = .false.
|
||||
case('REPRODUCIBLE','TRUE','T')
|
||||
ag%reproducible_matching =.true.
|
||||
end select
|
||||
case('PRMC_NEED_SYMMETRIZE')
|
||||
select case(psb_toupper(trim(val)))
|
||||
case('FALSE','F')
|
||||
ag%need_symmetrize = .false.
|
||||
case('SYMMETRIZE','TRUE','T')
|
||||
ag%need_symmetrize =.true.
|
||||
end select
|
||||
case('PRMC_UNSMOOTHED_HIERARCHY')
|
||||
select case(psb_toupper(trim(val)))
|
||||
case('F','FALSE')
|
||||
ag%unsmoothed_hierarchy = .false.
|
||||
case('T','TRUE')
|
||||
ag%unsmoothed_hierarchy =.true.
|
||||
end select
|
||||
case default
|
||||
! Do nothing
|
||||
end select
|
||||
return
|
||||
end subroutine amg_d_parmatch_aggr_csetc
|
||||
|
||||
subroutine amg_d_parmatch_aggr_cseti(ag,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, iwhat
|
||||
character(len=20) :: name='d_parmatch_aggr_cseti'
|
||||
info = psb_success_
|
||||
|
||||
! For now we ignore IDX
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('PRMC_MATCH_ALG')
|
||||
ag%matching_alg=val
|
||||
case('PRMC_SWEEPS')
|
||||
ag%n_sweeps=val
|
||||
case('AGGR_SIZE')
|
||||
ag%orig_aggr_size = val
|
||||
ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0)))
|
||||
case('PRMC_W_SIZE')
|
||||
call ag%bld_default_w(val)
|
||||
case('PRMC_REPRODUCIBLE_MATCHING')
|
||||
ag%reproducible_matching = (val == 1)
|
||||
case('PRMC_NEED_SYMMETRIZE')
|
||||
ag%need_symmetrize = (val == 1)
|
||||
case('PRMC_UNSMOOTHED_HIERARCHY')
|
||||
ag%unsmoothed_hierarchy = (val == 1)
|
||||
case default
|
||||
! Do nothing
|
||||
end select
|
||||
return
|
||||
end subroutine amg_d_parmatch_aggr_cseti
|
||||
|
||||
subroutine amg_d_parmatch_aggr_set_default(ag)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
|
||||
character(len=20) :: name='d_parmatch_aggr_set_default'
|
||||
call ag%amg_d_base_aggregator_type%default()
|
||||
ag%matching_alg = 0
|
||||
ag%n_sweeps = 1
|
||||
ag%jacobi_sweeps = 0
|
||||
!!$ ag%max_nlevels = 36
|
||||
!!$ ag%max_csize = -1
|
||||
!
|
||||
! Apparently BootCMatch works better
|
||||
! by keeping all entries
|
||||
!
|
||||
ag%do_clean_zeros = .false.
|
||||
|
||||
return
|
||||
|
||||
end subroutine amg_d_parmatch_aggr_set_default
|
||||
|
||||
subroutine amg_d_parmatch_aggregator_free(ag,info)
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
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%prol)) then
|
||||
call ag%prol%free(); deallocate(ag%prol,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%restr)) then
|
||||
call ag%restr%free(); deallocate(ag%restr,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%ac)) then
|
||||
call ag%ac%free(); deallocate(ag%ac,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%base_a)) then
|
||||
call ag%base_a%free(); deallocate(ag%base_a,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%rwa)) then
|
||||
call ag%rwa%free(); deallocate(ag%rwa,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%desc_ac)) then
|
||||
call ag%desc_ac%free(info); deallocate(ag%desc_ac,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%desc_ax)) then
|
||||
call ag%desc_ax%free(info); deallocate(ag%desc_ax,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%base_desc)) then
|
||||
call ag%base_desc%free(info); deallocate(ag%base_desc,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%rwdesc)) then
|
||||
call ag%rwdesc%free(info); deallocate(ag%rwdesc,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine amg_d_parmatch_aggregator_free
|
||||
|
||||
subroutine amg_d_parmatch_aggregator_clone(ag,agnext,info)
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
|
||||
class(amg_d_base_aggregator_type), allocatable, intent(inout) :: agnext
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(agnext)) then
|
||||
call agnext%free(info)
|
||||
if (info == 0) deallocate(agnext,stat=info)
|
||||
end if
|
||||
if (info /= 0) return
|
||||
allocate(agnext,source=ag,stat=info)
|
||||
select type(agnext)
|
||||
class is (amg_d_parmatch_aggregator_type)
|
||||
call agnext%set_c_default_w()
|
||||
class default
|
||||
! Should never ever get here
|
||||
info = -1
|
||||
end select
|
||||
end subroutine amg_d_parmatch_aggregator_clone
|
||||
|
||||
subroutine amg_d_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
& op_restr,op_prol,map,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(psb_desc_type), intent(in), target :: desc_a, desc_ac
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(psb_dspmat_type), intent(inout) :: op_prol, op_restr
|
||||
type(psb_dlinmap_type), intent(out) :: map
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_parmatch_aggregator_bld_map'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
!
|
||||
! Copy the prolongation/restriction matrices into the descriptor map.
|
||||
! op_restr => PR^T i.e. restriction operator
|
||||
! op_prol => PR i.e. prolongation operator
|
||||
!
|
||||
! For parmatch have an explicit copy of the descriptors
|
||||
!
|
||||
if (allocated(ag%desc_ax)) then
|
||||
!!$ write(0,*) 'Building linmap with ag%desc_ax ',ag%desc_ax%get_local_rows(),ag%desc_ax%get_local_cols(),&
|
||||
!!$ & desc_ac%get_local_rows(),desc_ac%get_local_cols()
|
||||
map = psb_linmap(psb_map_gen_linear_,ag%desc_ax,&
|
||||
& desc_ac,op_restr,op_prol,ilaggr,nlaggr)
|
||||
else
|
||||
map = psb_linmap(psb_map_gen_linear_,desc_a,&
|
||||
& desc_ac,op_restr,op_prol,ilaggr,nlaggr)
|
||||
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)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine amg_d_parmatch_aggregator_bld_map
|
||||
#endif
|
||||
end module amg_d_parmatch_aggregator_mod
|
||||
@@ -0,0 +1,548 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Daniela di Serafino
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
!
|
||||
!
|
||||
! File: amg_d_poly_smoother_mod.f90
|
||||
!
|
||||
! Module: amg_d_poly_smoother_mod
|
||||
!
|
||||
! This module defines:
|
||||
! the amg_d_poly_smoother_type data structure containing the
|
||||
! smoother for a Jacobi/block Jacobi smoother.
|
||||
! The smoother stores in ND the block off-diagonal matrix.
|
||||
! One special case is treated separately, when the solver is DIAG or L1-DIAG
|
||||
! then the ND is the entire off-diagonal part of the matrix (including the
|
||||
! main diagonal block), so that it becomes possible to implement
|
||||
! a pure Jacobi or L1-Jacobi global solver.
|
||||
!
|
||||
module amg_d_poly_coeff_mod
|
||||
use psb_base_mod
|
||||
|
||||
real(psb_dpk_), parameter :: amg_d_poly_a_vect(30) = [ &
|
||||
& 0.3333333333333333_psb_dpk_, &
|
||||
& 0.1805359927403007_psb_dpk_, &
|
||||
& 0.1159278464862213_psb_dpk_, &
|
||||
& 0.0820780659590383_psb_dpk_, &
|
||||
& 0.0618496002413377_psb_dpk_, &
|
||||
& 0.0486605823426062_psb_dpk_, &
|
||||
& 0.0395132986024057_psb_dpk_, &
|
||||
& 0.0328701017544880_psb_dpk_, &
|
||||
& 0.0278702862721800_psb_dpk_, &
|
||||
& 0.0239987409600620_psb_dpk_, &
|
||||
& 0.0209304400432259_psb_dpk_, &
|
||||
& 0.0184513099045066_psb_dpk_, &
|
||||
& 0.0164152586042591_psb_dpk_, &
|
||||
& 0.0147195638076874_psb_dpk_, &
|
||||
& 0.0132901324757843_psb_dpk_, &
|
||||
& 0.0120723317737698_psb_dpk_, &
|
||||
& 0.0110250964606384_psb_dpk_, &
|
||||
& 0.0101170330064859_psb_dpk_, &
|
||||
& 0.0093237789039835_psb_dpk_, &
|
||||
& 0.0086261728849515_psb_dpk_, &
|
||||
& 0.0080089618703679_psb_dpk_, &
|
||||
& 0.0074598709610601_psb_dpk_, &
|
||||
& 0.0069689238144320_psb_dpk_, &
|
||||
& 0.0065279387776372_psb_dpk_, &
|
||||
& 0.0061301503808627_psb_dpk_, &
|
||||
& 0.0057699215598864_psb_dpk_, &
|
||||
& 0.0054425224281914_psb_dpk_, &
|
||||
& 0.0051439584672521_psb_dpk_, &
|
||||
& 0.0048708358327268_psb_dpk_, &
|
||||
& 0.0046202548314912_psb_dpk_ ];
|
||||
|
||||
real(psb_dpk_), parameter :: amg_d_poly_beta_vect(900) = [ &
|
||||
& 1.1250000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0238728757031315_psb_dpk_, 1.2640890537108553_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0084254478202830_psb_dpk_, 1.0886783920873087_psb_dpk_, &
|
||||
& 1.3375312590961856_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0039131042728535_psb_dpk_, 1.0403581118859304_psb_dpk_, &
|
||||
& 1.1486349854625493_psb_dpk_, 1.3826886924100055_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0021293014616472_psb_dpk_, 1.0217371154926094_psb_dpk_, &
|
||||
& 1.0787243319260302_psb_dpk_, 1.1981006529266300_psb_dpk_, &
|
||||
& 1.4132254279168215_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0012851725594023_psb_dpk_, 1.0130429303523338_psb_dpk_, &
|
||||
& 1.0467821512411335_psb_dpk_, 1.1161648941967548_psb_dpk_, &
|
||||
& 1.2382902021844453_psb_dpk_, 1.4352429710674484_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0008346439791242_psb_dpk_, 1.0084394943012289_psb_dpk_, &
|
||||
& 1.0300870776871385_psb_dpk_, 1.0740838409200377_psb_dpk_, &
|
||||
& 1.1503618670736642_psb_dpk_, 1.2711647404613990_psb_dpk_, &
|
||||
& 1.4518665864936395_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0005724663119766_psb_dpk_, 1.0057742766241562_psb_dpk_, &
|
||||
& 1.0205018792294143_psb_dpk_, 1.0501980344456543_psb_dpk_, &
|
||||
& 1.1011557298494106_psb_dpk_, 1.1808604280685657_psb_dpk_, &
|
||||
& 1.2983858538257604_psb_dpk_, 1.4648607315109978_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0004096007283281_psb_dpk_, 1.0041243950610661_psb_dpk_, &
|
||||
& 1.0146021214826659_psb_dpk_, 1.0356111362667175_psb_dpk_, &
|
||||
& 1.0713997252919425_psb_dpk_, 1.1268827371096291_psb_dpk_, &
|
||||
& 1.2078521914072933_psb_dpk_, 1.3212193071674674_psb_dpk_, &
|
||||
& 1.4752964282069962_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0003031222965291_psb_dpk_, 1.0030484066079688_psb_dpk_, &
|
||||
& 1.0107702271538761_psb_dpk_, 1.0261901159764004_psb_dpk_, &
|
||||
& 1.0523172493375519_psb_dpk_, 1.0925574320754976_psb_dpk_, &
|
||||
& 1.1508337666397197_psb_dpk_, 1.2317225087089441_psb_dpk_, &
|
||||
& 1.3406080202445980_psb_dpk_, 1.4838612440701109_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0002305859520939_psb_dpk_, 1.0023167502402850_psb_dpk_, &
|
||||
& 1.0081724539630488_psb_dpk_, 1.0198298656634219_psb_dpk_, &
|
||||
& 1.0395021023532465_psb_dpk_, 1.0696504270054137_psb_dpk_, &
|
||||
& 1.1130575429574259_psb_dpk_, 1.1729087627556418_psb_dpk_, &
|
||||
& 1.2528830057679230_psb_dpk_, 1.3572557991951903_psb_dpk_, &
|
||||
& 1.4910167256413891_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0001794720082837_psb_dpk_, 1.0018018913961957_psb_dpk_, &
|
||||
& 1.0063486190730762_psb_dpk_, 1.0153786456630600_psb_dpk_, &
|
||||
& 1.0305694283076039_psb_dpk_, 1.0537601969394355_psb_dpk_, &
|
||||
& 1.0869986259207296_psb_dpk_, 1.1325918309791341_psb_dpk_, &
|
||||
& 1.1931627335817252_psb_dpk_, 1.2717129367511055_psb_dpk_, &
|
||||
& 1.3716933796979953_psb_dpk_, 1.4970841857556243_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0001424192155957_psb_dpk_, 1.0014290693262966_psb_dpk_, &
|
||||
& 1.0050302898629815_psb_dpk_, 1.0121691051849540_psb_dpk_, &
|
||||
& 1.0241487434279255_psb_dpk_, 1.0423815888082042_psb_dpk_, &
|
||||
& 1.0684200812870084_psb_dpk_, 1.1039901093675994_psb_dpk_, &
|
||||
& 1.1510274824264566_psb_dpk_, 1.2117181191012512_psb_dpk_, &
|
||||
& 1.2885426486512805_psb_dpk_, 1.3843261938099158_psb_dpk_, &
|
||||
& 1.5022941875736890_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0001149053826193_psb_dpk_, 1.0011524637691460_psb_dpk_, &
|
||||
& 1.0040535733326481_psb_dpk_, 1.0097959057315313_psb_dpk_, &
|
||||
& 1.0194130047299461_psb_dpk_, 1.0340142503543679_psb_dpk_, &
|
||||
& 1.0548059960662932_psb_dpk_, 1.0831142030181304_psb_dpk_, &
|
||||
& 1.1204089166089239_psb_dpk_, 1.1683309565544606_psb_dpk_, &
|
||||
& 1.2287212228823874_psb_dpk_, 1.3036530570781755_psb_dpk_, &
|
||||
& 1.3954681405367855_psb_dpk_, 1.5068164620958386_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000940475075257_psb_dpk_, 1.0009429169634352_psb_dpk_, &
|
||||
& 1.0033144905644482_psb_dpk_, 1.0080029483381612_psb_dpk_, &
|
||||
& 1.0158423625914039_psb_dpk_, 1.0277208331770495_psb_dpk_, &
|
||||
& 1.0445953542283146_psb_dpk_, 1.0675076120612534_psb_dpk_, &
|
||||
& 1.0976009254588965_psb_dpk_, 1.1361385536615733_psb_dpk_, &
|
||||
& 1.1845236142623621_psb_dpk_, 1.2443208730447588_psb_dpk_, &
|
||||
& 1.3172806908339272_psb_dpk_, 1.4053654389356023_psb_dpk_, &
|
||||
& 1.5107787250184523_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000779482817921_psb_dpk_, 1.0007812684725339_psb_dpk_, &
|
||||
& 1.0027448797440124_psb_dpk_, 1.0066229101701514_psb_dpk_, &
|
||||
& 1.0130985883697137_psb_dpk_, 1.0228944832933697_psb_dpk_, &
|
||||
& 1.0367832140998394_psb_dpk_, 1.0555987571989653_psb_dpk_, &
|
||||
& 1.0802484840556024_psb_dpk_, 1.1117260713149764_psb_dpk_, &
|
||||
& 1.1511254343107276_psb_dpk_, 1.1996558461497355_psb_dpk_, &
|
||||
& 1.2586584174494597_psb_dpk_, 1.3296241265666493_psb_dpk_, &
|
||||
& 1.4142136069557629_psb_dpk_, 1.5142789173034623_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000653242183546_psb_dpk_, 1.0006545722939437_psb_dpk_, &
|
||||
& 1.0022987777448662_psb_dpk_, 1.0055432691173583_psb_dpk_, &
|
||||
& 1.0109550075016893_psb_dpk_, 1.0191301541168694_psb_dpk_, &
|
||||
& 1.0307019481191382_psb_dpk_, 1.0463489778000818_psb_dpk_, &
|
||||
& 1.0668039321569163_psb_dpk_, 1.0928629244731740_psb_dpk_, &
|
||||
& 1.1253954850882542_psb_dpk_, 1.1653553270075827_psb_dpk_, &
|
||||
& 1.2137919954743157_psb_dpk_, 1.2718635211544003_psb_dpk_, &
|
||||
& 1.3408502062615073_psb_dpk_, 1.4221696838526183_psb_dpk_, &
|
||||
& 1.5173934027630227_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000552858792859_psb_dpk_, 1.0005538659610900_psb_dpk_, &
|
||||
& 1.0019444166743086_psb_dpk_, 1.0046864301776393_psb_dpk_, &
|
||||
& 1.0092557508630260_psb_dpk_, 1.0161502674772371_psb_dpk_, &
|
||||
& 1.0258958148322650_psb_dpk_, 1.0390523408953256_psb_dpk_, &
|
||||
& 1.0562203973533295_psb_dpk_, 1.0780480145522537_psb_dpk_, &
|
||||
& 1.1052380250439366_psb_dpk_, 1.1385559038570177_psb_dpk_, &
|
||||
& 1.1788381980793483_psb_dpk_, 1.2270016234308427_psb_dpk_, &
|
||||
& 1.2840529112630572_psb_dpk_, 1.3510994958895055_psb_dpk_, &
|
||||
& 1.4293611393851839_psb_dpk_, 1.5201825990516680_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000472036358790_psb_dpk_, 1.0004728102642675_psb_dpk_, &
|
||||
& 1.0016593577469159_psb_dpk_, 1.0039976891368516_psb_dpk_, &
|
||||
& 1.0078911941833455_psb_dpk_, 1.0137601583069535_psb_dpk_, &
|
||||
& 1.0220462561721002_psb_dpk_, 1.0332172281153209_psb_dpk_, &
|
||||
& 1.0477717791157513_psb_dpk_, 1.0662447417325256_psb_dpk_, &
|
||||
& 1.0892125464929936_psb_dpk_, 1.1172990456131733_psb_dpk_, &
|
||||
& 1.1511817386833911_psb_dpk_, 1.1915984520803475_psb_dpk_, &
|
||||
& 1.2393545273929878_psb_dpk_, 1.2953305781018039_psb_dpk_, &
|
||||
& 1.3604908781568688_psb_dpk_, 1.4358924509939206_psb_dpk_, &
|
||||
& 1.5226949329440265_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000406232569254_psb_dpk_, 1.0004068351374691_psb_dpk_, &
|
||||
& 1.0014274431564170_psb_dpk_, 1.0034377175807407_psb_dpk_, &
|
||||
& 1.0067826854070978_psb_dpk_, 1.0118204999571436_psb_dpk_, &
|
||||
& 1.0189259121271075_psb_dpk_, 1.0284938700470616_psb_dpk_, &
|
||||
& 1.0409432748132981_psb_dpk_, 1.0567209210598594_psb_dpk_, &
|
||||
& 1.0763056524407055_psb_dpk_, 1.1002127636100871_psb_dpk_, &
|
||||
& 1.1289986820268283_psb_dpk_, 1.1632659648787138_psb_dpk_, &
|
||||
& 1.2036686486408621_psb_dpk_, 1.2509179912601627_psb_dpk_, &
|
||||
& 1.3057886497146727_psb_dpk_, 1.3691253387497200_psb_dpk_, &
|
||||
& 1.4418500199624611_psb_dpk_, 1.5249696741164267_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000352114440929_psb_dpk_, 1.0003525892395289_psb_dpk_, &
|
||||
& 1.0012368357172980_psb_dpk_, 1.0029777430511673_psb_dpk_, &
|
||||
& 1.0058727830027672_psb_dpk_, 1.0102297507781717_psb_dpk_, &
|
||||
& 1.0163694815733537_psb_dpk_, 1.0246286588536329_psb_dpk_, &
|
||||
& 1.0353627340015590_psb_dpk_, 1.0489489776835172_psb_dpk_, &
|
||||
& 1.0657896841306789_psb_dpk_, 1.0863155505114006_psb_dpk_, &
|
||||
& 1.1109892546943501_psb_dpk_, 1.1403092559728156_psb_dpk_, &
|
||||
& 1.1748138447471401_psb_dpk_, 1.2150854687543668_psb_dpk_, &
|
||||
& 1.2617553651999671_psb_dpk_, 1.3155085300984379_psb_dpk_, &
|
||||
& 1.3770890582780710_psb_dpk_, 1.4473058898645985_psb_dpk_, &
|
||||
& 1.5270390016420912_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000307198714835_psb_dpk_, 1.0003075769178242_psb_dpk_, &
|
||||
& 1.0010787281022711_psb_dpk_, 1.0025963829693492_psb_dpk_, &
|
||||
& 1.0051188625231162_psb_dpk_, 1.0089126974249720_psb_dpk_, &
|
||||
& 1.0142547789760521_psb_dpk_, 1.0214345766593154_psb_dpk_, &
|
||||
& 1.0307564364069204_psb_dpk_, 1.0425419742322541_psb_dpk_, &
|
||||
& 1.0571325804249445_psb_dpk_, 1.0748920501551993_psb_dpk_, &
|
||||
& 1.0962093570737961_psb_dpk_, 1.1215015873309027_psb_dpk_, &
|
||||
& 1.1512170523743910_psb_dpk_, 1.1858385999327761_psb_dpk_, &
|
||||
& 1.2258871437439198_psb_dpk_, 1.2719254338660289_psb_dpk_, &
|
||||
& 1.3245620908078453_psb_dpk_, 1.3844559282498121_psb_dpk_, &
|
||||
& 1.4523205908039656_psb_dpk_, 1.5289295350887884_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000269609460124_psb_dpk_, 1.0002699137181752_psb_dpk_, &
|
||||
& 1.0009464748475532_psb_dpk_, 1.0022775198638552_psb_dpk_, &
|
||||
& 1.0044888368184179_psb_dpk_, 1.0078128087804721_psb_dpk_, &
|
||||
& 1.0124901352066715_psb_dpk_, 1.0187716022931539_psb_dpk_, &
|
||||
& 1.0269199126829005_psb_dpk_, 1.0372115852204526_psb_dpk_, &
|
||||
& 1.0499389358225151_psb_dpk_, 1.0654121509688057_psb_dpk_, &
|
||||
& 1.0839614658147161_psb_dpk_, 1.1059394594887115_psb_dpk_, &
|
||||
& 1.1317234807654135_psb_dpk_, 1.1617182180038959_psb_dpk_, &
|
||||
& 1.1963584280123116_psb_dpk_, 1.2361118393501820_psb_dpk_, &
|
||||
& 1.2814822465106404_psb_dpk_, 1.3330128124440397_psb_dpk_, &
|
||||
& 1.3912895979940381_psb_dpk_, 1.4569453380258381_psb_dpk_, &
|
||||
& 1.5306634853375161_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000237911597230_psb_dpk_, 1.0002381585998457_psb_dpk_, &
|
||||
& 1.0008349974382460_psb_dpk_, 1.0020088476285827_psb_dpk_, &
|
||||
& 1.0039582343156432_psb_dpk_, 1.0068870298152559_psb_dpk_, &
|
||||
& 1.0110058445931565_psb_dpk_, 1.0165334547611182_psb_dpk_, &
|
||||
& 1.0236982737890488_psb_dpk_, 1.0327398763510158_psb_dpk_, &
|
||||
& 1.0439105824804926_psb_dpk_, 1.0574771105088172_psb_dpk_, &
|
||||
& 1.0737223076000839_psb_dpk_, 1.0929469670793606_psb_dpk_, &
|
||||
& 1.1154717421787756_psb_dpk_, 1.1416391663018148_psb_dpk_, &
|
||||
& 1.1718157904303341_psb_dpk_, 1.2063944488757254_psb_dpk_, &
|
||||
& 1.2457966652063013_psb_dpk_, 1.2904752108716941_psb_dpk_, &
|
||||
& 1.3409168297942540_psb_dpk_, 1.3976451430108305_psb_dpk_, &
|
||||
& 1.4612237483301715_psb_dpk_, 1.5322595309246121_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000210994601235_psb_dpk_, 1.0002111968041199_psb_dpk_, &
|
||||
& 1.0007403694573151_psb_dpk_, 1.0017808593384865_psb_dpk_, &
|
||||
& 1.0035081686576977_psb_dpk_, 1.0061021720448531_psb_dpk_, &
|
||||
& 1.0097482505685551_psb_dpk_, 1.0146384533048582_psb_dpk_, &
|
||||
& 1.0209726922414943_psb_dpk_, 1.0289599764553270_psb_dpk_, &
|
||||
& 1.0388196916802268_psb_dpk_, 1.0507829315895938_psb_dpk_, &
|
||||
& 1.0650938873538003_psb_dpk_, 1.0820113022982043_psb_dpk_, &
|
||||
& 1.1018099987843295_psb_dpk_, 1.1247824847650900_psb_dpk_, &
|
||||
& 1.1512406478277994_psb_dpk_, 1.1815175449359154_psb_dpk_, &
|
||||
& 1.2159692965153148_psb_dpk_, 1.2549770940040335_psb_dpk_, &
|
||||
& 1.2989493304988182_psb_dpk_, 1.3483238646890843_psb_dpk_, &
|
||||
& 1.4035704288718982_psb_dpk_, 1.4651931924923849_psb_dpk_, &
|
||||
& 1.5337334933563860_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000187989989242_psb_dpk_, 1.0001881567984481_psb_dpk_, &
|
||||
& 1.0006595227084085_psb_dpk_, 1.0015861311895899_psb_dpk_, &
|
||||
& 1.0031239047778964_psb_dpk_, 1.0054323694760092_psb_dpk_, &
|
||||
& 1.0086755868504005_psb_dpk_, 1.0130231071421940_psb_dpk_, &
|
||||
& 1.0186509477893992_psb_dpk_, 1.0257426018654052_psb_dpk_, &
|
||||
& 1.0344900810652515_psb_dpk_, 1.0450949980170887_psb_dpk_, &
|
||||
& 1.0577696928624343_psb_dpk_, 1.0727384092356933_psb_dpk_, &
|
||||
& 1.0902385249817814_psb_dpk_, 1.1105218431816117_psb_dpk_, &
|
||||
& 1.1338559493090710_psb_dpk_, 1.1605256406217599_psb_dpk_, &
|
||||
& 1.1908344341913664_psb_dpk_, 1.2251061603103259_psb_dpk_, &
|
||||
& 1.2636866483695495_psb_dpk_, 1.3069455126904677_psb_dpk_, &
|
||||
& 1.3552780462128098_psb_dpk_, 1.4091072303921326_psb_dpk_, &
|
||||
& 1.4688858701459975_psb_dpk_, 1.5350988632115488_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000168211938973_psb_dpk_, 1.0001683505351420_psb_dpk_, &
|
||||
& 1.0005900360142315_psb_dpk_, 1.0014188084960041_psb_dpk_, &
|
||||
& 1.0027938311393803_psb_dpk_, 1.0048572584314193_psb_dpk_, &
|
||||
& 1.0077550080990554_psb_dpk_, 1.0116375492127350_psb_dpk_, &
|
||||
& 1.0166607098595459_psb_dpk_, 1.0229865078405374_psb_dpk_, &
|
||||
& 1.0307840079371537_psb_dpk_, 1.0402302093961155_psb_dpk_, &
|
||||
& 1.0515109674005423_psb_dpk_, 1.0648219524284319_psb_dpk_, &
|
||||
& 1.0803696515480321_psb_dpk_, 1.0983724158638981_psb_dpk_, &
|
||||
& 1.1190615585080472_psb_dpk_, 1.1426825077681895_psb_dpk_, &
|
||||
& 1.1694960201606786_psb_dpk_, 1.1997794584895700_psb_dpk_, &
|
||||
& 1.2338281401870808_psb_dpk_, 1.2719567615042522_psb_dpk_, &
|
||||
& 1.3145009034164739_psb_dpk_, 1.3618186254259919_psb_dpk_, &
|
||||
& 1.4142921537855777_psb_dpk_, 1.4723296710339275_psb_dpk_, &
|
||||
& 1.5363672141264497_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000151113991291_psb_dpk_, 1.0001512299115287_psb_dpk_, &
|
||||
& 1.0005299814085029_psb_dpk_, 1.0012742317597600_psb_dpk_, &
|
||||
& 1.0025087130476142_psb_dpk_, 1.0043606572645858_psb_dpk_, &
|
||||
& 1.0069604400315522_psb_dpk_, 1.0104422369100252_psb_dpk_, &
|
||||
& 1.0149446949285030_psb_dpk_, 1.0206116219981500_psb_dpk_, &
|
||||
& 1.0275926969588451_psb_dpk_, 1.0360442030716124_psb_dpk_, &
|
||||
& 1.0461297878595799_psb_dpk_, 1.0580212522952626_psb_dpk_, &
|
||||
& 1.0718993724396861_psb_dpk_, 1.0879547567564958_psb_dpk_, &
|
||||
& 1.1063887424550545_psb_dpk_, 1.1274143343577541_psb_dpk_, &
|
||||
& 1.1512571899424711_psb_dpk_, 1.1781566543781672_psb_dpk_, &
|
||||
& 1.2083668495540898_psb_dpk_, 1.2421578212983135_psb_dpk_, &
|
||||
& 1.2798167491932815_psb_dpk_, 1.3216492236219661_psb_dpk_, &
|
||||
& 1.3679805949228399_psb_dpk_, 1.4191573997915068_psb_dpk_, &
|
||||
& 1.4755488703473389_psb_dpk_, 1.5375485315807513_psb_dpk_, &
|
||||
& 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000136257096588_psb_dpk_, 1.0001363546506836_psb_dpk_, &
|
||||
& 1.0004778107488095_psb_dpk_, 1.0011486612681773_psb_dpk_, &
|
||||
& 1.0022611433613271_psb_dpk_, 1.0039295964948667_psb_dpk_, &
|
||||
& 1.0062710027404669_psb_dpk_, 1.0094055369479136_psb_dpk_, &
|
||||
& 1.0134571288503909_psb_dpk_, 1.0185540391932908_psb_dpk_, &
|
||||
& 1.0248294520252528_psb_dpk_, 1.0324220853457433_psb_dpk_, &
|
||||
& 1.0414768223656390_psb_dpk_, 1.0521453657079123_psb_dpk_, &
|
||||
& 1.0645869169533493_psb_dpk_, 1.0789688840227822_psb_dpk_, &
|
||||
& 1.0954676189818162_psb_dpk_, 1.1142691889576817_psb_dpk_, &
|
||||
& 1.1355701829701565_psb_dpk_, 1.1595785576006521_psb_dpk_, &
|
||||
& 1.1865145245551894_psb_dpk_, 1.2166114833191515_psb_dpk_, &
|
||||
& 1.2501170022543431_psb_dpk_, 1.2872938516530203_psb_dpk_, &
|
||||
& 1.3284210924391027_psb_dpk_, 1.3737952243949607_psb_dpk_, &
|
||||
& 1.4237313979931023_psb_dpk_, 1.4785646941265451_psb_dpk_, &
|
||||
& 1.5386514762605854_psb_dpk_, 0.0000000000000000_psb_dpk_, &
|
||||
& 1.0000123285767939_psb_dpk_, 1.0001233683396147_psb_dpk_, &
|
||||
& 1.0004322711781202_psb_dpk_, 1.0010390719329101_psb_dpk_, &
|
||||
& 1.0020451337350940_psb_dpk_, 1.0035535979966428_psb_dpk_, &
|
||||
& 1.0056698406248343_psb_dpk_, 1.0085019360540697_psb_dpk_, &
|
||||
& 1.0121611307132341_psb_dpk_, 1.0167623275769953_psb_dpk_, &
|
||||
& 1.0224245834847208_psb_dpk_, 1.0292716209515502_psb_dpk_, &
|
||||
& 1.0374323562422998_psb_dpk_, 1.0470414455308106_psb_dpk_, &
|
||||
& 1.0582398510249318_psb_dpk_, 1.0711754290010183_psb_dpk_, &
|
||||
& 1.0860035417614331_psb_dpk_, 1.1028876956049132_psb_dpk_, &
|
||||
& 1.1220002069820316_psb_dpk_, 1.1435228990979547_psb_dpk_, &
|
||||
& 1.1676478313209715_psb_dpk_, 1.1945780638597872_psb_dpk_, &
|
||||
& 1.2245284602839432_psb_dpk_, 1.2577265305821996_psb_dpk_, &
|
||||
& 1.2944133175813315_psb_dpk_, 1.3348443296857557_psb_dpk_, &
|
||||
& 1.3792905230439911_psb_dpk_, 1.4280393364047606_psb_dpk_, &
|
||||
& 1.4813957820911738_psb_dpk_, 1.5396835966986973_psb_dpk_ ]
|
||||
|
||||
|
||||
|
||||
|
||||
!!$ [1.1250000000000000_psb_dpk_, 0.0_psb_dpk_, 0.0_psb_dpk__psb_dpk_,,&
|
||||
!!$ & 1.0238728757031315_psb_dpk_, 1.2640890537108553_psb_dpk_, 0.0_psb_dpk_,&
|
||||
!!$ & 1.0084254478202830_psb_dpk_, 1.0886783920873087_psb_dpk_, 1.3375312590961856_psb_dpk_]
|
||||
|
||||
real(psb_dpk_), parameter :: amg_d_poly_beta_mat(30,30)=reshape(amg_d_poly_beta_vect,[30,30])
|
||||
|
||||
end module amg_d_poly_coeff_mod
|
||||
@@ -0,0 +1,374 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Daniela di Serafino
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
!
|
||||
!
|
||||
! File: amg_d_poly_smoother_mod.f90
|
||||
!
|
||||
! Module: amg_d_poly_smoother_mod
|
||||
!
|
||||
! This module defines:
|
||||
! the amg_d_poly_smoother_type data structure containing the
|
||||
! smoother for a Jacobi/block Jacobi smoother.
|
||||
! The smoother stores in ND the block off-diagonal matrix.
|
||||
! One special case is treated separately, when the solver is DIAG or L1-DIAG
|
||||
! then the ND is the entire off-diagonal part of the matrix (including the
|
||||
! main diagonal block), so that it becomes possible to implement
|
||||
! a pure Jacobi or L1-Jacobi global solver.
|
||||
!
|
||||
module amg_d_poly_smoother
|
||||
use amg_d_base_smoother_mod
|
||||
use amg_d_poly_coeff_mod
|
||||
|
||||
type, extends(amg_d_base_smoother_type) :: amg_d_poly_smoother_type
|
||||
! The local solver component is inherited from the
|
||||
! parent type.
|
||||
! class(amg_d_base_solver_type), allocatable :: sv
|
||||
!
|
||||
integer(psb_ipk_) :: pdegree, variant
|
||||
integer(psb_ipk_) :: rho_estimate=amg_poly_rho_est_power_
|
||||
integer(psb_ipk_) :: rho_estimate_iterations=10
|
||||
type(psb_dspmat_type), pointer :: pa => null()
|
||||
real(psb_dpk_), allocatable :: poly_beta(:)
|
||||
real(psb_dpk_) :: cf_a = dzero
|
||||
real(psb_dpk_) :: rho_ba = -done
|
||||
contains
|
||||
procedure, pass(sm) :: apply_v => amg_d_poly_smoother_apply_vect
|
||||
!!$ procedure, pass(sm) :: apply_a => amg_d_poly_smoother_apply
|
||||
procedure, pass(sm) :: dump => amg_d_poly_smoother_dmp
|
||||
procedure, pass(sm) :: build => amg_d_poly_smoother_bld
|
||||
procedure, pass(sm) :: cnv => amg_d_poly_smoother_cnv
|
||||
procedure, pass(sm) :: clone => amg_d_poly_smoother_clone
|
||||
procedure, pass(sm) :: clone_settings => amg_d_poly_smoother_clone_settings
|
||||
procedure, pass(sm) :: clear_data => amg_d_poly_smoother_clear_data
|
||||
procedure, pass(sm) :: free => d_poly_smoother_free
|
||||
procedure, pass(sm) :: cseti => amg_d_poly_smoother_cseti
|
||||
procedure, pass(sm) :: csetc => amg_d_poly_smoother_csetc
|
||||
procedure, pass(sm) :: csetr => amg_d_poly_smoother_csetr
|
||||
procedure, pass(sm) :: descr => amg_d_poly_smoother_descr
|
||||
procedure, pass(sm) :: sizeof => d_poly_smoother_sizeof
|
||||
procedure, pass(sm) :: default => d_poly_smoother_default
|
||||
procedure, pass(sm) :: get_nzeros => d_poly_smoother_get_nzeros
|
||||
procedure, pass(sm) :: get_wrksz => d_poly_smoother_get_wrksize
|
||||
procedure, nopass :: get_fmt => d_poly_smoother_get_fmt
|
||||
procedure, nopass :: get_id => d_poly_smoother_get_id
|
||||
end type amg_d_poly_smoother_type
|
||||
private :: d_poly_smoother_free, &
|
||||
& d_poly_smoother_sizeof, d_poly_smoother_get_nzeros, &
|
||||
& d_poly_smoother_get_fmt, d_poly_smoother_get_id, &
|
||||
& d_poly_smoother_get_wrksize
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
& sweeps,work,wv,info,init,initu)
|
||||
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_ipk_
|
||||
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
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
|
||||
integer(psb_ipk_), intent(in) :: sweeps
|
||||
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_poly_smoother_apply_vect
|
||||
end interface
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine amg_d_poly_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
!!$ & sweeps,work,info,init,initu)
|
||||
!!$ 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_ipk_
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
!!$ 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
|
||||
!!$ integer(psb_ipk_), intent(in) :: sweeps
|
||||
!!$ 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_poly_smoother_apply
|
||||
!!$ end interface
|
||||
!!$
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
|
||||
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_ipk_, psb_i_base_vect_type
|
||||
type(psb_dspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
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_poly_smoother_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_cnv(sm,info,amold,vmold,imold)
|
||||
import :: amg_d_poly_smoother_type, psb_dpk_, &
|
||||
& psb_d_base_sparse_mat, psb_d_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
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_poly_smoother_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
|
||||
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
|
||||
& psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, &
|
||||
& psb_ipk_
|
||||
implicit none
|
||||
class(amg_d_poly_smoother_type), intent(in) :: sm
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix, head
|
||||
logical, optional, intent(in) :: smoother, solver, global_num
|
||||
end subroutine amg_d_poly_smoother_dmp
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_clone(sm,smout,info)
|
||||
import :: amg_d_poly_smoother_type, psb_dpk_, &
|
||||
& amg_d_base_smoother_type, psb_ipk_
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
class(amg_d_base_smoother_type), allocatable, intent(inout) :: smout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_poly_smoother_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_clone_settings(sm,smout,info)
|
||||
import :: amg_d_poly_smoother_type, psb_dpk_, &
|
||||
& amg_d_base_smoother_type, psb_ipk_
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
class(amg_d_base_smoother_type), intent(inout) :: smout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_poly_smoother_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_clear_data(sm,info)
|
||||
import :: amg_d_poly_smoother_type, psb_dpk_, &
|
||||
& amg_d_base_smoother_type, psb_ipk_
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_d_poly_smoother_clear_data
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
import :: amg_d_poly_smoother_type, psb_ipk_
|
||||
class(amg_d_poly_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_d_poly_smoother_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_cseti(sm,what,val,info,idx)
|
||||
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
|
||||
& psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
|
||||
implicit none
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_d_poly_smoother_cseti
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_csetc(sm,what,val,info,idx)
|
||||
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
|
||||
& psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
|
||||
implicit none
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_d_poly_smoother_csetc
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_d_poly_smoother_csetr(sm,what,val,info,idx)
|
||||
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
|
||||
& psb_dpk_, amg_d_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
|
||||
implicit none
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_d_poly_smoother_csetr
|
||||
end interface
|
||||
|
||||
|
||||
contains
|
||||
|
||||
|
||||
subroutine d_poly_smoother_free(sm,info)
|
||||
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_poly_smoother_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
|
||||
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%free(info)
|
||||
if (info == psb_success_) deallocate(sm%sv,stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
end if
|
||||
if (allocated(sm%poly_beta)) deallocate(sm%poly_beta)
|
||||
sm%pa => null()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine d_poly_smoother_free
|
||||
|
||||
function d_poly_smoother_sizeof(sm) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_d_poly_smoother_type), intent(in) :: sm
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = psb_sizeof_dp
|
||||
if (allocated(sm%sv)) val = val + sm%sv%sizeof()
|
||||
if (allocated(sm%poly_beta)) val = val + psb_sizeof_dp * size(sm%poly_beta)
|
||||
|
||||
return
|
||||
end function d_poly_smoother_sizeof
|
||||
|
||||
subroutine d_poly_smoother_default(sm)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
|
||||
!
|
||||
! Default: BJAC with no residual check
|
||||
!
|
||||
sm%pdegree = 1
|
||||
sm%rho_ba = -done
|
||||
sm%variant = amg_cheb_4_
|
||||
sm%rho_estimate = amg_poly_rho_est_power_
|
||||
sm%rho_estimate_iterations = 20
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%default()
|
||||
end if
|
||||
|
||||
return
|
||||
end subroutine d_poly_smoother_default
|
||||
|
||||
function d_poly_smoother_get_nzeros(sm) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_d_poly_smoother_type), intent(in) :: sm
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = 0
|
||||
if (allocated(sm%sv)) val = val + sm%sv%get_nzeros()
|
||||
|
||||
return
|
||||
end function d_poly_smoother_get_nzeros
|
||||
|
||||
function d_poly_smoother_get_wrksize(sm) result(val)
|
||||
implicit none
|
||||
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = 4
|
||||
if (allocated(sm%sv)) val = val + sm%sv%get_wrksz()
|
||||
|
||||
end function d_poly_smoother_get_wrksize
|
||||
|
||||
function d_poly_smoother_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Polynomial smoother"
|
||||
end function d_poly_smoother_get_fmt
|
||||
|
||||
function d_poly_smoother_get_id() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_poly_
|
||||
end function d_poly_smoother_get_id
|
||||
|
||||
|
||||
end module amg_d_poly_smoother
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -40,7 +40,7 @@
|
||||
! Module: amg_d_prec_mod
|
||||
!
|
||||
! This module defines the user interfaces to the real/complex, single/double
|
||||
! precision versions of the user-level MLD2P4 routines.
|
||||
! precision versions of the user-level AMG4PSBLAS routines.
|
||||
!
|
||||
module amg_d_prec_mod
|
||||
|
||||
@@ -55,12 +55,7 @@ module amg_d_prec_mod
|
||||
use amg_d_ainv_solver
|
||||
use amg_d_invk_solver
|
||||
use amg_d_invt_solver
|
||||
|
||||
interface amg_precset
|
||||
module procedure amg_d_iprecsetsm, amg_d_iprecsetsv, &
|
||||
& amg_d_cprecseti, amg_d_cprecsetc, amg_d_cprecsetr, &
|
||||
& amg_d_iprecsetag
|
||||
end interface amg_precset
|
||||
use amg_d_krm_solver
|
||||
|
||||
interface amg_extprol_bld
|
||||
subroutine amg_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
|
||||
@@ -82,61 +77,4 @@ module amg_d_prec_mod
|
||||
end subroutine amg_d_extprol_bld
|
||||
end interface amg_extprol_bld
|
||||
|
||||
contains
|
||||
|
||||
subroutine amg_d_iprecsetsm(p,val,info,pos)
|
||||
type(amg_dprec_type), intent(inout) :: p
|
||||
class(amg_d_base_smoother_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(val,info,pos=pos)
|
||||
end subroutine amg_d_iprecsetsm
|
||||
|
||||
subroutine amg_d_iprecsetsv(p,val,info,pos)
|
||||
type(amg_dprec_type), intent(inout) :: p
|
||||
class(amg_d_base_solver_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
call p%set(val,info, pos=pos)
|
||||
end subroutine amg_d_iprecsetsv
|
||||
|
||||
subroutine amg_d_iprecsetag(p,val,info,pos)
|
||||
type(amg_dprec_type), intent(inout) :: p
|
||||
class(amg_d_base_aggregator_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
call p%set(val,info, pos=pos)
|
||||
end subroutine amg_d_iprecsetag
|
||||
|
||||
subroutine amg_d_cprecseti(p,what,val,info,pos)
|
||||
type(amg_dprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_d_cprecseti
|
||||
|
||||
subroutine amg_d_cprecsetr(p,what,val,info,pos)
|
||||
type(amg_dprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_d_cprecsetr
|
||||
|
||||
subroutine amg_d_cprecsetc(p,what,val,info,pos)
|
||||
type(amg_dprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_d_cprecsetc
|
||||
|
||||
end module amg_d_prec_mod
|
||||
|
||||
+124
-17
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -66,7 +66,7 @@ module amg_d_prec_type
|
||||
!
|
||||
! This is the data type containing all the information about the multilevel
|
||||
! preconditioner ('d', 's', 'c' and 'z', according to the real/complex,
|
||||
! single/double precision version of MLD2P4).
|
||||
! single/double precision version of AMG4PSBLAS).
|
||||
! It consists of an array of 'one-level' intermediate data structures
|
||||
! of type amg_donelev_type, each containing the information needed to apply
|
||||
! the smoothing and the coarse-space correction at a generic level. RT is the
|
||||
@@ -135,8 +135,11 @@ module amg_d_prec_type
|
||||
procedure, pass(prec) :: build => amg_dprecbld
|
||||
procedure, pass(prec) :: hierarchy_build => amg_d_hierarchy_bld
|
||||
procedure, pass(prec) :: hierarchy_rebuild => amg_d_hierarchy_rebld
|
||||
procedure, pass(prec) :: hierarchy_free => amg_d_hierarchy_free
|
||||
procedure, pass(prec) :: smoothers_build => amg_d_smoothers_bld
|
||||
procedure, pass(prec) :: smoothers_free => amg_d_smoothers_free
|
||||
procedure, pass(prec) :: descr => amg_dfile_prec_descr
|
||||
procedure, pass(prec) :: memory_use => amg_dfile_prec_memory_use
|
||||
end type amg_dprec_type
|
||||
|
||||
private :: amg_d_dump, amg_d_get_compl, amg_d_cmp_compl,&
|
||||
@@ -155,16 +158,35 @@ module amg_d_prec_type
|
||||
|
||||
|
||||
interface amg_precdescr
|
||||
subroutine amg_dfile_prec_descr(prec,iout,root)
|
||||
subroutine amg_dfile_prec_descr(prec,info,iout,root,verbosity,prefix)
|
||||
import :: amg_dprec_type, psb_ipk_
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_dprec_type), intent(in) :: prec
|
||||
class(amg_dprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_dfile_prec_descr
|
||||
end interface
|
||||
|
||||
|
||||
interface amg_memory_use
|
||||
subroutine amg_dfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
|
||||
import :: amg_dprec_type, psb_ipk_
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_dprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: global
|
||||
end subroutine amg_dfile_prec_memory_use
|
||||
end interface
|
||||
|
||||
interface amg_sizeof
|
||||
module procedure amg_dprec_sizeof
|
||||
end interface
|
||||
@@ -342,6 +364,14 @@ module amg_d_prec_type
|
||||
end subroutine amg_d_smoothers_bld
|
||||
end interface amg_smoothers_bld
|
||||
|
||||
interface amg_smoothers_free
|
||||
module procedure amg_d_smoothers_free
|
||||
end interface amg_smoothers_free
|
||||
|
||||
interface amg_hierarchy_free
|
||||
module procedure amg_d_hierarchy_free
|
||||
end interface amg_hierarchy_free
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning a pointer to the smoother
|
||||
@@ -424,11 +454,22 @@ contains
|
||||
end if
|
||||
end function amg_d_get_nzeros
|
||||
|
||||
function amg_dprec_sizeof(prec) result(val)
|
||||
function amg_dprec_sizeof(prec, global) result(val)
|
||||
implicit none
|
||||
class(amg_dprec_type), intent(in) :: prec
|
||||
integer(psb_epk_) :: val
|
||||
logical, intent(in), optional :: global
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
|
||||
logical :: global_
|
||||
|
||||
if (present(global)) then
|
||||
global_ = global
|
||||
else
|
||||
global_ = .false.
|
||||
end if
|
||||
|
||||
val = 0
|
||||
val = val + psb_sizeof_ip
|
||||
if (allocated(prec%precv)) then
|
||||
@@ -436,6 +477,11 @@ contains
|
||||
val = val + prec%precv(i)%sizeof()
|
||||
end do
|
||||
end if
|
||||
if (global_) then
|
||||
ctxt = prec%ctxt
|
||||
call psb_sum(ctxt,val)
|
||||
end if
|
||||
|
||||
end function amg_dprec_sizeof
|
||||
|
||||
!
|
||||
@@ -599,6 +645,68 @@ contains
|
||||
|
||||
end subroutine amg_d_prec_free
|
||||
|
||||
subroutine amg_d_smoothers_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_d_smoothers_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,size(prec%precv)
|
||||
call prec%precv(i)%free_smoothers(info)
|
||||
end do
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_d_smoothers_free
|
||||
|
||||
subroutine amg_d_hierarchy_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_dprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_d_hierarchy_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
me=-1
|
||||
write(0,*) 'Missing implementation '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_d_hierarchy_free
|
||||
|
||||
|
||||
!
|
||||
@@ -738,16 +846,15 @@ contains
|
||||
character(len=*), intent(in), optional :: prefix, head
|
||||
logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num
|
||||
integer(psb_ipk_) :: i, j, il1, iln, lev
|
||||
type(psb_ctxt_type) :: icontxt
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: iam, np, iproc_
|
||||
character(len=80) :: prefix_
|
||||
character(len=120) :: fname ! len should be at least 20 more than
|
||||
! len of prefix_
|
||||
|
||||
info = 0
|
||||
icontxt = prec%ctxt
|
||||
call psb_info(icontxt,iam,np)
|
||||
|
||||
ctxt = prec%ctxt
|
||||
call psb_info(ctxt,iam,np)
|
||||
iln = size(prec%precv)
|
||||
if (present(istart)) then
|
||||
il1 = max(1,istart)
|
||||
@@ -812,13 +919,13 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
! Local vars
|
||||
integer(psb_ipk_) :: i, j, ln, lev
|
||||
type(psb_ctxt_type) :: icontxt
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: iam, np
|
||||
|
||||
info = psb_success_
|
||||
select type(pout => precout)
|
||||
class is (amg_dprec_type)
|
||||
pout%ctxt = prec%ctxt
|
||||
pout%ctxt = prec%ctxt
|
||||
pout%ag_data = prec%ag_data
|
||||
pout%outer_sweeps = prec%outer_sweeps
|
||||
if (allocated(prec%precv)) then
|
||||
@@ -834,8 +941,8 @@ contains
|
||||
if (info == psb_success_) then
|
||||
pout%precv(lev)%base_a => pout%precv(lev)%ac
|
||||
pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
|
||||
pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
|
||||
pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
|
||||
pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
|
||||
pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
|
||||
end if
|
||||
end do
|
||||
end if
|
||||
@@ -875,8 +982,8 @@ contains
|
||||
do i=2, size(b%precv)
|
||||
b%precv(i)%base_a => b%precv(i)%ac
|
||||
b%precv(i)%base_desc => b%precv(i)%desc_ac
|
||||
b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
|
||||
b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
|
||||
b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
|
||||
b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -385,20 +385,22 @@ contains
|
||||
|
||||
end subroutine d_slu_solver_finalize
|
||||
|
||||
subroutine d_slu_solver_descr(sv,info,iout,coarse)
|
||||
subroutine d_slu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_slu_solver_type), intent(in) :: sv
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer :: err_act
|
||||
character(len=20), parameter :: name='amg_d_slu_solver_descr'
|
||||
integer :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -407,8 +409,13 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) ' SuperLU Sparse Factorization Solver. '
|
||||
write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -52,7 +52,7 @@ module amg_d_sludist_solver
|
||||
use iso_c_binding
|
||||
use amg_d_base_solver_mod
|
||||
|
||||
#if defined(LPK8)
|
||||
#if (!defined(HAVE_SLUDIST_)) || defined(IPK8)
|
||||
|
||||
type, extends(amg_d_base_solver_type) :: amg_d_sludist_solver_type
|
||||
|
||||
@@ -270,10 +270,12 @@ contains
|
||||
! Local variables
|
||||
type(psb_dspmat_type) :: atmp
|
||||
type(psb_d_csr_sparse_mat) :: acsr
|
||||
integer :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc
|
||||
integer :: ifrst, ibcheck
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer :: np,me,i, err_act, debug_unit, debug_level
|
||||
integer(psb_lpk_), allocatable :: gia(:), gja(:)
|
||||
integer(psb_lpk_) :: lfrst
|
||||
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nglob, nzt, npr, npc
|
||||
integer(psb_ipk_) :: ifrst, ibcheck
|
||||
integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
|
||||
character(len=20) :: name='d_sludist_solver_bld', ch_err
|
||||
|
||||
info=psb_success_
|
||||
@@ -293,19 +295,36 @@ contains
|
||||
n_col = desc_a%get_local_cols()
|
||||
nglob = desc_a%get_global_rows()
|
||||
|
||||
call a%cscnv(atmp,info,type='coo')
|
||||
!
|
||||
! Strategy here is as follows: because a call to SLUDIST
|
||||
! as a gobal solver is mostly done at the coarsest level,
|
||||
! even if we start from a problem requiring 8 bytes, chances
|
||||
! are that the global size will be suitable for 4 bytes
|
||||
! anyway, so we hope for the best, and throw an error
|
||||
! if something goes wrong.
|
||||
!
|
||||
if (nglob > huge(1_psb_ipk_)) then
|
||||
write(0,*) me,' ',trim(name),': Error: overflow of local indices '
|
||||
info=psb_err_internal_error_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call a%cscnv(atmp,info,type='csr')
|
||||
! This in case we are dealing with AS
|
||||
call psb_rwextd(n_row,atmp,info,b=b)
|
||||
call atmp%cscnv(info,type='csr',dupl=psb_dupl_add_)
|
||||
call atmp%mv_to(acsr)
|
||||
nrow_a = acsr%get_nrows()
|
||||
nztota = acsr%get_nzeros()
|
||||
call psb_loc_to_glob(ione,lfrst,desc_a,info)
|
||||
|
||||
! Fix the entries to call C-base SuperLU
|
||||
call psb_loc_to_glob(1,ifrst,desc_a,info)
|
||||
call psb_loc_to_glob(nrow_a,ibcheck,desc_a,info)
|
||||
call psb_loc_to_glob(acsr%ja(1:nztota),desc_a,info,iact='I')
|
||||
call psb_realloc(nztota,gja,info)
|
||||
call psb_loc_to_glob(acsr%ja(1:nztota),gja(1:nztota), desc_a, info, iact='I')
|
||||
acsr%ja(1:nztota) = gja(1:nztota)
|
||||
acsr%ja(:) = acsr%ja(:) - 1
|
||||
acsr%irp(:) = acsr%irp(:) - 1
|
||||
ifrst = ifrst - 1
|
||||
ifrst = lfrst - 1
|
||||
info = amg_dsludist_fact(nglob,nrow_a,nztota,ifrst,&
|
||||
& acsr%val,acsr%irp,acsr%ja,sv%lufactors,&
|
||||
& npr,npc)
|
||||
@@ -318,7 +337,6 @@ contains
|
||||
end if
|
||||
|
||||
call acsr%free()
|
||||
call atmp%free()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),' end'
|
||||
@@ -403,15 +421,16 @@ contains
|
||||
|
||||
end subroutine d_sludist_solver_finalize
|
||||
|
||||
subroutine d_sludist_solver_descr(sv,info,iout,coarse)
|
||||
subroutine d_sludist_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_sludist_solver_type), intent(in) :: sv
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer :: err_act
|
||||
@@ -419,6 +438,7 @@ contains
|
||||
integer :: me, np
|
||||
character(len=20), parameter :: name='amg_d_sludist_solver_descr'
|
||||
integer :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -427,8 +447,13 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) ' SuperLU_Dist Sparse Factorization Solver. '
|
||||
write(iout_,*) trim(prefix_), ' SuperLU_Dist Sparse Factorization Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -88,16 +88,25 @@ contains
|
||||
val = "Symmetric Decoupled aggregation"
|
||||
end function amg_d_symdec_aggregator_fmt
|
||||
|
||||
subroutine amg_d_symdec_aggregator_descr(ag,parms,iout,info)
|
||||
subroutine amg_d_symdec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
implicit none
|
||||
class(amg_d_symdec_aggregator_type), intent(in) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
write(iout,*) 'Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
character(1024) :: prefix_
|
||||
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
|
||||
return
|
||||
end subroutine amg_d_symdec_aggregator_descr
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -390,20 +390,22 @@ contains
|
||||
|
||||
end subroutine d_umf_solver_finalize
|
||||
|
||||
subroutine d_umf_solver_descr(sv,info,iout,coarse)
|
||||
subroutine d_umf_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_d_umf_solver_type), intent(in) :: sv
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer :: err_act
|
||||
character(len=20), parameter :: name='amg_d_umf_solver_descr'
|
||||
integer :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -412,8 +414,13 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) ' UMFPACK Sparse Factorization Solver. '
|
||||
write(iout_,*) trim(prefix_), ' UMFPACK Sparse Factorization Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -2,7 +2,7 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
@@ -40,7 +40,7 @@
|
||||
! Module: amg_prec_mod
|
||||
!
|
||||
! This module defines the interfaces to the real/complex, single/double
|
||||
! precision versions of the user-level MLD2P4 routines.
|
||||
! precision versions of the user-level AMG4PSBLAS routines.
|
||||
!
|
||||
module amg_prec_mod
|
||||
|
||||
|
||||
@@ -2,7 +2,7 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
|
||||
@@ -1,11 +1,14 @@
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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
|
||||
@@ -55,13 +58,10 @@ module amg_s_ainv_solver
|
||||
procedure, pass(sv) :: check => amg_s_ainv_solver_check
|
||||
procedure, pass(sv) :: build => amg_s_ainv_solver_bld
|
||||
procedure, pass(sv) :: clone => amg_s_ainv_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_s_ainv_solver_clone_settings
|
||||
procedure, pass(sv) :: cseti => amg_s_ainv_solver_cseti
|
||||
procedure, pass(sv) :: csetc => amg_s_ainv_solver_csetc
|
||||
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
|
||||
generic, public :: set => seti, setr, setc
|
||||
procedure, pass(sv) :: descr => amg_s_ainv_solver_descr
|
||||
procedure, pass(sv) :: default => s_ainv_solver_default
|
||||
procedure, nopass :: stringval => s_ainv_stringval
|
||||
@@ -83,6 +83,16 @@ module amg_s_ainv_solver
|
||||
end subroutine amg_s_ainv_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_ainv_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& amg_s_base_solver_type, psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_s_ainv_solver_type), intent(inout) :: sv
|
||||
class(amg_s_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_ainv_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
@@ -159,44 +169,44 @@ module amg_s_ainv_solver
|
||||
end subroutine amg_s_ainv_solver_csetr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_ainv_solver_setc(sv,what,val,info)
|
||||
import :: amg_s_ainv_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_s_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_ainv_solver_setc
|
||||
end interface
|
||||
!!$ interface
|
||||
!!$ subroutine amg_s_ainv_solver_setc(sv,what,val,info)
|
||||
!!$ import :: amg_s_ainv_solver_type, psb_ipk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_s_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ character(len=*), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_s_ainv_solver_setc
|
||||
!!$ end interface
|
||||
!!$
|
||||
!!$ interface
|
||||
!!$ subroutine amg_s_ainv_solver_seti(sv,what,val,info)
|
||||
!!$ import :: amg_s_ainv_solver_type, psb_ipk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_s_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ integer(psb_ipk_), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_s_ainv_solver_seti
|
||||
!!$ end interface
|
||||
!!$
|
||||
!!$ interface
|
||||
!!$ subroutine amg_s_ainv_solver_setr(sv,what,val,info)
|
||||
!!$ import :: amg_s_ainv_solver_type, psb_ipk_, psb_spk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_s_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ real(psb_spk_), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_s_ainv_solver_setr
|
||||
!!$ end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_ainv_solver_seti(sv,what,val,info)
|
||||
import :: amg_s_ainv_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_s_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_ainv_solver_seti
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_ainv_solver_setr(sv,what,val,info)
|
||||
import :: amg_s_ainv_solver_type, psb_ipk_, psb_spk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_s_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_ainv_solver_setr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse)
|
||||
subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse,prefix)
|
||||
import :: psb_dpk_, amg_s_ainv_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -206,7 +216,7 @@ module amg_s_ainv_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_s_ainv_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -396,21 +396,23 @@ contains
|
||||
end subroutine s_as_smoother_default
|
||||
|
||||
|
||||
subroutine s_as_smoother_descr(sm,info,iout,coarse)
|
||||
subroutine s_as_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_as_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_as_smoother_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
logical :: coarse_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -424,16 +426,21 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (.not.coarse_) then
|
||||
write(iout_,*) ' Additive Schwarz with ',&
|
||||
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
|
||||
& sm%novr, ' overlap layers.'
|
||||
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) ' Local solver:'
|
||||
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) trim(prefix_), ' Local solver:'
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%descr(info,iout_,coarse=coarse)
|
||||
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -126,7 +126,7 @@ module amg_s_base_aggregator_mod
|
||||
& psb_s_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
|
||||
implicit none
|
||||
type(psb_s_csr_sparse_mat), intent(inout) :: a_csr
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_s_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
|
||||
@@ -144,7 +144,7 @@ module amg_s_base_aggregator_mod
|
||||
& psb_s_coo_sparse_mat, amg_sml_parms, psb_spk_, psb_ipk_, psb_lpk_
|
||||
implicit none
|
||||
type(psb_s_csr_sparse_mat), intent(inout) :: a_csr
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_s_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
|
||||
@@ -275,15 +275,22 @@ contains
|
||||
val = .false.
|
||||
end function amg_s_base_aggregator_xt_desc
|
||||
|
||||
subroutine amg_s_base_aggregator_descr(ag,parms,iout,info)
|
||||
subroutine amg_s_base_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
implicit none
|
||||
class(amg_s_base_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
|
||||
return
|
||||
end subroutine amg_s_base_aggregator_descr
|
||||
|
||||
@@ -1,11 +1,14 @@
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -272,7 +272,7 @@ module amg_s_base_smoother_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_base_smoother_descr(sm,info,iout,coarse)
|
||||
subroutine amg_s_base_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
& amg_s_base_smoother_type, psb_ipk_
|
||||
@@ -281,6 +281,7 @@ module amg_s_base_smoother_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_s_base_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -270,7 +270,7 @@ module amg_s_base_solver_mod
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_base_solver_descr(sv,info,iout,coarse)
|
||||
subroutine amg_s_base_solver_descr(sv,info,iout,coarse,prefix)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
& amg_s_base_solver_type, psb_ipk_
|
||||
@@ -281,7 +281,7 @@ module amg_s_base_solver_mod
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_s_base_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -184,16 +184,23 @@ contains
|
||||
val = "Decoupled aggregation"
|
||||
end function amg_s_dec_aggregator_fmt
|
||||
|
||||
subroutine amg_s_dec_aggregator_descr(ag,parms,iout,info)
|
||||
subroutine amg_s_dec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
implicit none
|
||||
class(amg_s_dec_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) 'Decoupled Aggregator'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
|
||||
return
|
||||
end subroutine amg_s_dec_aggregator_descr
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -219,7 +219,7 @@ contains
|
||||
|
||||
end subroutine s_diag_solver_free
|
||||
|
||||
subroutine s_diag_solver_descr(sv,info,iout,coarse)
|
||||
subroutine s_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -228,11 +228,13 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -240,8 +242,13 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
|
||||
write(iout_,*) ' Diagonal local solver '
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' Diagonal local solver '
|
||||
|
||||
return
|
||||
|
||||
@@ -352,7 +359,7 @@ module amg_s_l1_diag_solver
|
||||
|
||||
contains
|
||||
|
||||
subroutine s_l1_diag_solver_descr(sv,info,iout,coarse)
|
||||
subroutine s_l1_diag_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -361,11 +368,13 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_l1_diag_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -373,8 +382,13 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
|
||||
write(iout_,*) ' L1 Diagonal solver '
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) trim(prefix_), ' L1 Diagonal solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
+28
-14
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -433,20 +433,22 @@ contains
|
||||
return
|
||||
end subroutine s_gs_solver_free
|
||||
|
||||
subroutine s_gs_solver_descr(sv,info,iout,coarse)
|
||||
subroutine s_gs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_gs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_gs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -455,12 +457,17 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) trim(prefix_), ' Forward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
@@ -526,20 +533,22 @@ contains
|
||||
val = .true.
|
||||
end function s_gs_solver_is_iterative
|
||||
|
||||
subroutine s_bwgs_solver_descr(sv,info,iout,coarse)
|
||||
subroutine s_bwgs_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_bwgs_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_bwgs_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -548,12 +557,17 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with ',&
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
write(iout_,*) trim(prefix_), ' Backward Gauss-Seidel iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
|
||||
@@ -1,125 +0,0 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (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,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -157,7 +157,7 @@ contains
|
||||
return
|
||||
end subroutine s_id_solver_free
|
||||
|
||||
subroutine s_id_solver_descr(sv,info,iout,coarse)
|
||||
subroutine s_id_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -165,12 +165,14 @@ contains
|
||||
class(amg_s_id_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_id_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
@@ -178,8 +180,13 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) ' Identity local solver '
|
||||
write(iout_,*) trim(prefix_), ' Identity local solver '
|
||||
|
||||
return
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -234,7 +234,7 @@ contains
|
||||
! Arguments
|
||||
class(amg_s_ilu_solver_type), intent(inout) :: sv
|
||||
|
||||
sv%fact_type = psb_ilu_n_
|
||||
sv%fact_type = amg_ilu_n_
|
||||
sv%fill_in = 0
|
||||
sv%thresh = szero
|
||||
|
||||
@@ -255,13 +255,13 @@ contains
|
||||
info = psb_success_
|
||||
|
||||
call amg_check_def(sv%fact_type,&
|
||||
& 'Factorization',psb_ilu_n_,is_legal_ilu_fact)
|
||||
& 'Factorization',amg_ilu_n_,is_legal_ilu_fact)
|
||||
|
||||
select case(sv%fact_type)
|
||||
case(psb_ilu_n_,psb_milu_n_)
|
||||
case(amg_ilu_n_,amg_milu_n_)
|
||||
call amg_check_def(sv%fill_in,&
|
||||
& 'Level',izero,is_int_non_negative)
|
||||
case(psb_ilu_t_)
|
||||
case(amg_ilu_t_)
|
||||
call amg_check_def(sv%thresh,&
|
||||
& 'Eps',szero,is_legal_s_fact_thrs)
|
||||
end select
|
||||
@@ -406,7 +406,7 @@ contains
|
||||
return
|
||||
end subroutine s_ilu_solver_free
|
||||
|
||||
subroutine s_ilu_solver_descr(sv,info,iout,coarse)
|
||||
subroutine s_ilu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -414,12 +414,14 @@ contains
|
||||
class(amg_s_ilu_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_ilu_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -428,15 +430,20 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) ' Incomplete factorization solver: ',&
|
||||
write(iout_,*) trim(prefix_), ' Incomplete factorization solver: ',&
|
||||
& amg_fact_names(sv%fact_type)
|
||||
select case(sv%fact_type)
|
||||
case(psb_ilu_n_,psb_milu_n_)
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
case(psb_ilu_t_)
|
||||
write(iout_,*) ' Fill level:',sv%fill_in
|
||||
write(iout_,*) ' Fill threshold :',sv%thresh
|
||||
case(amg_ilu_n_,amg_milu_n_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
case(amg_ilu_t_)
|
||||
write(iout_,*) trim(prefix_), ' Fill level:',sv%fill_in
|
||||
write(iout_,*) trim(prefix_), ' Fill threshold :',sv%thresh
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -489,7 +496,7 @@ contains
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = psb_ilu_n_
|
||||
val = amg_ilu_n_
|
||||
end function s_ilu_solver_get_id
|
||||
|
||||
function s_ilu_solver_get_wrksize() result(val)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -39,7 +39,7 @@
|
||||
!
|
||||
! Module: amg_inner_mod
|
||||
!
|
||||
! This module defines the interfaces to inner MLD2P4 routines.
|
||||
! This module defines the interfaces to inner AMG4PSBLAS routines.
|
||||
! The interfaces of the user level routines are defined in amg_prec_mod.f90.
|
||||
!
|
||||
module amg_s_inner_mod
|
||||
@@ -109,11 +109,12 @@ module amg_s_inner_mod
|
||||
end interface amg_map_to_tprol
|
||||
|
||||
abstract interface
|
||||
subroutine amg_saggrmat_var_bld(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
subroutine amg_saggrmat_var_bld(dol1smoothing,a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lpk_, psb_lsspmat_type
|
||||
import :: amg_s_onelev_type, amg_sml_parms
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: dol1smoothing
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
|
||||
@@ -1,11 +1,14 @@
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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
|
||||
@@ -49,10 +52,9 @@ module amg_s_invk_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_s_invk_solver_check
|
||||
procedure, pass(sv) :: clone => amg_s_invk_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_s_invk_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_s_invk_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_s_invk_solver_cseti
|
||||
procedure, pass(sv) :: seti => amg_s_invk_solver_seti
|
||||
generic, public :: set => seti
|
||||
procedure, pass(sv) :: descr => amg_s_invk_solver_descr
|
||||
procedure, pass(sv) :: default => s_invk_solver_default
|
||||
end type amg_s_invk_solver_type
|
||||
@@ -72,6 +74,17 @@ module amg_s_invk_solver
|
||||
end subroutine amg_s_invk_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invk_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& amg_s_base_solver_type, psb_spk_, amg_s_invk_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_s_invk_solver_type), intent(inout) :: sv
|
||||
class(amg_s_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_invk_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
@@ -122,7 +135,7 @@ module amg_s_invk_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invk_solver_descr(sv,info,iout,coarse)
|
||||
subroutine amg_s_invk_solver_descr(sv,info,iout,coarse,prefix)
|
||||
import :: psb_spk_, amg_s_invk_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -132,22 +145,10 @@ module amg_s_invk_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_s_invk_solver_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invk_solver_seti(sv,what,val,info)
|
||||
import :: amg_s_invk_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_s_invk_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_invk_solver_seti
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine s_invk_solver_default(sv)
|
||||
|
||||
@@ -1,11 +1,14 @@
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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
|
||||
@@ -49,12 +52,10 @@ module amg_s_invt_solver
|
||||
contains
|
||||
procedure, pass(sv) :: check => amg_s_invt_solver_check
|
||||
procedure, pass(sv) :: clone => amg_s_invt_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_s_invt_solver_clone_settings
|
||||
procedure, pass(sv) :: build => amg_s_invt_solver_bld
|
||||
procedure, pass(sv) :: cseti => amg_s_invt_solver_cseti
|
||||
procedure, pass(sv) :: csetr => amg_s_invt_solver_csetr
|
||||
procedure, pass(sv) :: seti => amg_s_invt_solver_seti
|
||||
procedure, pass(sv) :: setr => amg_s_invt_solver_setr
|
||||
generic, public :: set => seti, setr
|
||||
procedure, pass(sv) :: descr => amg_s_invt_solver_descr
|
||||
procedure, pass(sv) :: default => s_invt_solver_default
|
||||
end type amg_s_invt_solver_type
|
||||
@@ -73,6 +74,17 @@ module amg_s_invt_solver
|
||||
end subroutine amg_s_invt_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invt_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& amg_s_base_solver_type, psb_spk_, amg_s_invt_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_s_invt_solver_type), intent(inout) :: sv
|
||||
class(amg_s_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_invt_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
@@ -134,44 +146,21 @@ module amg_s_invt_solver
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invt_solver_descr(sv,info,iout,coarse)
|
||||
subroutine amg_s_invt_solver_descr(sv,info,iout,coarse,prefix)
|
||||
import :: psb_spk_, amg_s_invt_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_invt_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
end subroutine amg_s_invt_solver_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invt_solver_setr(sv,what,val,info)
|
||||
import :: amg_s_invt_solver_type, psb_spk_, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_s_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_invt_solver_setr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_invt_solver_seti(sv,what,val,info)
|
||||
import :: amg_s_invt_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_s_invt_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine s_invt_solver_default(sv)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -203,8 +203,8 @@ module amg_s_jac_smoother
|
||||
subroutine amg_s_jac_smoother_clone_settings(sm,smout,info)
|
||||
import :: amg_s_jac_smoother_type, psb_spk_, &
|
||||
& amg_s_base_smoother_type, psb_ipk_
|
||||
class(amg_s_jac_smoother_type), intent(inout) :: sm
|
||||
class(amg_s_base_smoother_type), allocatable, intent(inout) :: smout
|
||||
class(amg_s_jac_smoother_type), intent(inout) :: sm
|
||||
class(amg_s_base_smoother_type), intent(inout) :: smout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_jac_smoother_clone_settings
|
||||
end interface
|
||||
@@ -219,12 +219,13 @@ module amg_s_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse)
|
||||
subroutine amg_s_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
import :: amg_s_jac_smoother_type, psb_ipk_
|
||||
class(amg_s_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_s_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
@@ -313,12 +314,13 @@ module amg_s_jac_smoother
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse)
|
||||
subroutine amg_s_l1_jac_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
import :: amg_s_l1_jac_smoother_type, psb_ipk_
|
||||
class(amg_s_l1_jac_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_s_l1_jac_smoother_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -0,0 +1,585 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! File: amg_s_jac_solver_mod.f90
|
||||
!
|
||||
! Module: amg_s_jac_solver_mod
|
||||
!
|
||||
! This module defines:
|
||||
! - the amg_s_jac_solver_type data structure containing the ingredients
|
||||
! for a local Jacobi iteration. The iterations are local to a process
|
||||
! (they operate on the block diagonal).
|
||||
!
|
||||
!
|
||||
module amg_s_jac_solver
|
||||
|
||||
use amg_s_base_solver_mod
|
||||
|
||||
type, extends(amg_s_base_solver_type) :: amg_s_jac_solver_type
|
||||
type(psb_sspmat_type) :: a
|
||||
type(psb_s_vect_type), allocatable :: dv
|
||||
real(psb_spk_), allocatable :: d(:)
|
||||
integer(psb_ipk_) :: sweeps
|
||||
real(psb_spk_) :: eps
|
||||
contains
|
||||
procedure, pass(sv) :: dump => amg_s_jac_solver_dmp
|
||||
procedure, pass(sv) :: check => s_jac_solver_check
|
||||
procedure, pass(sv) :: clone => amg_s_jac_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_s_jac_solver_clone_settings
|
||||
procedure, pass(sv) :: clear_data => amg_s_jac_solver_clear_data
|
||||
procedure, pass(sv) :: build => amg_s_jac_solver_bld
|
||||
procedure, pass(sv) :: cnv => amg_s_jac_solver_cnv
|
||||
procedure, pass(sv) :: apply_v => amg_s_jac_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => amg_s_jac_solver_apply
|
||||
procedure, pass(sv) :: free => s_jac_solver_free
|
||||
procedure, pass(sv) :: cseti => s_jac_solver_cseti
|
||||
procedure, pass(sv) :: csetc => s_jac_solver_csetc
|
||||
procedure, pass(sv) :: csetr => s_jac_solver_csetr
|
||||
procedure, pass(sv) :: descr => s_jac_solver_descr
|
||||
procedure, pass(sv) :: default => s_jac_solver_default
|
||||
procedure, pass(sv) :: sizeof => s_jac_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => s_jac_solver_get_nzeros
|
||||
procedure, nopass :: get_wrksz => s_jac_solver_get_wrksize
|
||||
procedure, nopass :: get_fmt => s_jac_solver_get_fmt
|
||||
procedure, nopass :: get_id => s_jac_solver_get_id
|
||||
procedure, nopass :: is_iterative => s_jac_solver_is_iterative
|
||||
end type amg_s_jac_solver_type
|
||||
|
||||
type, extends(amg_s_jac_solver_type) :: amg_s_l1_jac_solver_type
|
||||
contains
|
||||
procedure, pass(sv) :: build => amg_s_l1_jac_solver_bld
|
||||
procedure, pass(sv) :: descr => s_l1_jac_solver_descr
|
||||
procedure, nopass :: get_fmt => s_l1_jac_solver_get_fmt
|
||||
procedure, nopass :: get_id => s_l1_jac_solver_get_id
|
||||
end type amg_s_l1_jac_solver_type
|
||||
|
||||
|
||||
private :: s_jac_solver_bld, s_jac_solver_apply, &
|
||||
& s_jac_solver_free, &
|
||||
& s_jac_solver_descr, s_jac_solver_sizeof, &
|
||||
& s_jac_solver_default, s_jac_solver_dmp, &
|
||||
& s_jac_solver_apply_vect, s_jac_solver_get_nzeros, &
|
||||
& s_jac_solver_get_fmt, s_jac_solver_check,&
|
||||
& s_jac_solver_is_iterative, &
|
||||
& s_jac_solver_get_id, s_jac_solver_get_wrksize
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
type(psb_s_vect_type),intent(inout) :: x
|
||||
type(psb_s_vect_type),intent(inout) :: y
|
||||
real(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_spk_),target, intent(inout) :: work(:)
|
||||
type(psb_s_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_s_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_s_jac_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info,init,initu)
|
||||
import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
real(psb_spk_),intent(inout) :: x(:)
|
||||
real(psb_spk_),intent(inout) :: y(:)
|
||||
real(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
real(psb_spk_),target, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_spk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_s_jac_solver_apply
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_sspmat_type), intent(in), target, optional :: b
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_s_jac_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_s_l1_jac_solver_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_l1_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_sspmat_type), intent(in), target, optional :: b
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_s_l1_jac_solver_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_solver_cnv(sv,info,amold,vmold,imold)
|
||||
import :: amg_s_jac_solver_type, psb_spk_, &
|
||||
& psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_s_jac_solver_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
|
||||
import :: psb_desc_type, amg_s_jac_solver_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, &
|
||||
& psb_ipk_
|
||||
implicit none
|
||||
class(amg_s_jac_solver_type), intent(in) :: sv
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix, head
|
||||
logical, optional, intent(in) :: solver, global_num
|
||||
end subroutine amg_s_jac_solver_dmp
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_solver_clone(sv,svout,info)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
& amg_s_base_solver_type, amg_s_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_jac_solver_clone
|
||||
end interface
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine amg_s_l1_jac_solver_clone(sv,svout,info)
|
||||
!!$ import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
!!$ & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
!!$ & amg_s_base_solver_type, amg_s_l1_jac_solver_type, psb_ipk_
|
||||
!!$ Implicit None
|
||||
!!$
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_s_l1_jac_solver_type), intent(inout) :: sv
|
||||
!!$ class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_s_l1_jac_solver_clone
|
||||
!!$ end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
& amg_s_base_solver_type, amg_s_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
class(amg_s_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_jac_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_jac_solver_clear_data(sv,info)
|
||||
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
|
||||
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
|
||||
& amg_s_jac_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_jac_solver_clear_data
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine s_jac_solver_default(sv)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
|
||||
sv%sweeps = ione
|
||||
sv%eps = dzero
|
||||
|
||||
return
|
||||
end subroutine s_jac_solver_default
|
||||
|
||||
subroutine s_jac_solver_check(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_jac_solver_check'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
call amg_check_def(sv%sweeps,&
|
||||
& 'Jacobi sweeps',ione,is_int_positive)
|
||||
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine s_jac_solver_check
|
||||
|
||||
subroutine s_jac_solver_cseti(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_jac_solver_cseti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('SOLVER_SWEEPS')
|
||||
sv%sweeps = val
|
||||
case default
|
||||
call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_jac_solver_cseti
|
||||
|
||||
subroutine s_jac_solver_csetc(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='s_jac_solver_csetc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_jac_solver_csetc
|
||||
|
||||
subroutine s_jac_solver_csetr(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_jac_solver_csetr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('SOLVER_EPS')
|
||||
sv%eps = val
|
||||
case default
|
||||
call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
|
||||
end select
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_jac_solver_csetr
|
||||
|
||||
subroutine s_jac_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_jac_solver_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
call sv%a%free()
|
||||
if (allocated(sv%dv)) then
|
||||
call sv%dv%free(info)
|
||||
deallocate(sv%dv)
|
||||
end if
|
||||
if (allocated(sv%d)) deallocate(sv%d)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_jac_solver_free
|
||||
|
||||
subroutine s_jac_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_jac_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
iout_ = iout
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' Jacobi iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_jac_solver_descr
|
||||
|
||||
function s_jac_solver_get_nzeros(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = 0
|
||||
val = val + sv%a%get_nzeros()
|
||||
val = val + sv%dv%get_nrows()
|
||||
|
||||
return
|
||||
end function s_jac_solver_get_nzeros
|
||||
|
||||
function s_jac_solver_sizeof(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_s_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = psb_sizeof_ip
|
||||
val = val + sv%a%sizeof()
|
||||
val = val + sv%dv%sizeof()
|
||||
|
||||
return
|
||||
end function s_jac_solver_sizeof
|
||||
|
||||
function s_jac_solver_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Jacobi solver"
|
||||
end function s_jac_solver_get_fmt
|
||||
|
||||
function s_jac_solver_get_id() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_jac_
|
||||
end function s_jac_solver_get_id
|
||||
|
||||
!
|
||||
! If this is true, then the solver needs a starting
|
||||
! guess. Currently only handled in JAC smoother.
|
||||
!
|
||||
function s_jac_solver_is_iterative() result(val)
|
||||
implicit none
|
||||
logical :: val
|
||||
|
||||
val = .true.
|
||||
end function s_jac_solver_is_iterative
|
||||
|
||||
function s_jac_solver_get_wrksize() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = 2
|
||||
end function s_jac_solver_get_wrksize
|
||||
|
||||
subroutine s_l1_jac_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_l1_jac_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_l1_jac_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (present(iout)) then
|
||||
iout_ = iout
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%eps<=dzero) then
|
||||
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with ',&
|
||||
& sv%sweeps,' sweeps'
|
||||
else
|
||||
write(iout_,*) trim(prefix_), ' L1-Jacobi iterative solver with tolerance',&
|
||||
& sv%eps,' and maxit', sv%sweeps
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_l1_jac_solver_descr
|
||||
|
||||
function s_l1_jac_solver_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "L1-Jacobi solver"
|
||||
end function s_l1_jac_solver_get_fmt
|
||||
|
||||
function s_l1_jac_solver_get_id() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_l1_jac_
|
||||
end function s_l1_jac_solver_get_id
|
||||
|
||||
end module amg_s_jac_solver
|
||||
@@ -1,11 +1,14 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
@@ -52,14 +55,14 @@
|
||||
! 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 MLD2P4 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
|
||||
! 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 MLD2P4 GROUP OR ITS CONTRIBUTORS
|
||||
! 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
|
||||
@@ -70,16 +73,16 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
! File: amg_s_rkr_solver_mod.f90
|
||||
! File: amg_s_krm_solver_mod.f90
|
||||
!
|
||||
! Module: amg_s_rkr_solver_mod
|
||||
! Module: amg_s_krm_solver_mod
|
||||
!
|
||||
module amg_s_rkr_solver
|
||||
module amg_s_krm_solver
|
||||
|
||||
use amg_s_base_solver_mod
|
||||
use amg_s_prec_type
|
||||
|
||||
type, extends(amg_s_base_solver_type) :: amg_s_rkr_solver_type
|
||||
type, extends(amg_s_base_solver_type) :: amg_s_krm_solver_type
|
||||
!
|
||||
logical :: global
|
||||
character(len=16) :: method, kprec, sub_solve
|
||||
@@ -94,46 +97,46 @@ module amg_s_rkr_solver
|
||||
contains
|
||||
!
|
||||
!
|
||||
procedure, pass(sv) :: dump => s_rkr_solver_dmp
|
||||
procedure, pass(sv) :: check => s_rkr_solver_check
|
||||
procedure, pass(sv) :: clone => s_rkr_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => s_rkr_solver_clone_settings
|
||||
procedure, pass(sv) :: cnv => s_rkr_solver_cnv
|
||||
procedure, pass(sv) :: apply_v => amg_s_rkr_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => amg_s_rkr_solver_apply
|
||||
procedure, pass(sv) :: clear_data => s_rkr_solver_clear_data
|
||||
procedure, pass(sv) :: free => s_rkr_solver_free
|
||||
procedure, pass(sv) :: cseti => s_rkr_solver_cseti
|
||||
procedure, pass(sv) :: csetc => s_rkr_solver_csetc
|
||||
procedure, pass(sv) :: csetr => s_rkr_solver_csetr
|
||||
procedure, pass(sv) :: sizeof => s_rkr_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => s_rkr_solver_get_nzeros
|
||||
!procedure, nopass :: get_id => s_rkr_solver_get_id
|
||||
procedure, pass(sv) :: is_global => s_rkr_solver_is_global
|
||||
procedure, nopass :: is_iterative => s_rkr_solver_is_iterative
|
||||
procedure, pass(sv) :: dump => s_krm_solver_dmp
|
||||
procedure, pass(sv) :: check => s_krm_solver_check
|
||||
procedure, pass(sv) :: clone => s_krm_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => s_krm_solver_clone_settings
|
||||
procedure, pass(sv) :: cnv => s_krm_solver_cnv
|
||||
procedure, pass(sv) :: apply_v => amg_s_krm_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => amg_s_krm_solver_apply
|
||||
procedure, pass(sv) :: clear_data => s_krm_solver_clear_data
|
||||
procedure, pass(sv) :: free => s_krm_solver_free
|
||||
procedure, pass(sv) :: cseti => s_krm_solver_cseti
|
||||
procedure, pass(sv) :: csetc => s_krm_solver_csetc
|
||||
procedure, pass(sv) :: csetr => s_krm_solver_csetr
|
||||
procedure, pass(sv) :: sizeof => s_krm_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => s_krm_solver_get_nzeros
|
||||
!procedure, nopass :: get_id => s_krm_solver_get_id
|
||||
procedure, pass(sv) :: is_global => s_krm_solver_is_global
|
||||
procedure, nopass :: is_iterative => s_krm_solver_is_iterative
|
||||
|
||||
|
||||
!
|
||||
! These methods are specific for the new solver type
|
||||
! and therefore need to be overridden
|
||||
!
|
||||
procedure, pass(sv) :: descr => s_rkr_solver_descr
|
||||
procedure, pass(sv) :: default => s_rkr_solver_default
|
||||
procedure, pass(sv) :: build => amg_s_rkr_solver_bld
|
||||
procedure, nopass :: get_fmt => s_rkr_solver_get_fmt
|
||||
end type amg_s_rkr_solver_type
|
||||
procedure, pass(sv) :: descr => s_krm_solver_descr
|
||||
procedure, pass(sv) :: default => s_krm_solver_default
|
||||
procedure, pass(sv) :: build => amg_s_krm_solver_bld
|
||||
procedure, nopass :: get_fmt => s_krm_solver_get_fmt
|
||||
end type amg_s_krm_solver_type
|
||||
|
||||
|
||||
private :: s_rkr_solver_get_fmt, s_rkr_solver_descr, s_rkr_solver_default
|
||||
private :: s_krm_solver_get_fmt, s_krm_solver_descr, s_krm_solver_default
|
||||
|
||||
interface
|
||||
subroutine amg_s_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
subroutine amg_s_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,wv,info,init,initu)
|
||||
import :: psb_desc_type, amg_s_rkr_solver_type, psb_s_vect_type, psb_spk_, &
|
||||
import :: psb_desc_type, amg_s_krm_solver_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_s_krm_solver_type), intent(inout) :: sv
|
||||
type(psb_s_vect_type),intent(inout) :: x
|
||||
type(psb_s_vect_type),intent(inout) :: y
|
||||
real(psb_spk_),intent(in) :: alpha,beta
|
||||
@@ -143,17 +146,17 @@ module amg_s_rkr_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_s_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_s_rkr_solver_apply_vect
|
||||
end subroutine amg_s_krm_solver_apply_vect
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
subroutine amg_s_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
|
||||
& trans,work,info,init,initu)
|
||||
import :: psb_desc_type, amg_s_rkr_solver_type, psb_s_vect_type, psb_spk_, &
|
||||
import :: psb_desc_type, amg_s_krm_solver_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_s_krm_solver_type), intent(inout) :: sv
|
||||
real(psb_spk_),intent(inout) :: x(:)
|
||||
real(psb_spk_),intent(inout) :: y(:)
|
||||
real(psb_spk_),intent(in) :: alpha,beta
|
||||
@@ -162,24 +165,24 @@ module amg_s_rkr_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
real(psb_spk_),intent(inout), optional :: initu(:)
|
||||
end subroutine amg_s_rkr_solver_apply
|
||||
end subroutine amg_s_krm_solver_apply
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_s_rkr_solver_type, psb_s_vect_type, psb_spk_, &
|
||||
subroutine amg_s_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
import :: psb_desc_type, amg_s_krm_solver_type, psb_s_vect_type, psb_spk_, &
|
||||
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_s_krm_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
type(psb_sspmat_type), intent(in), target, optional :: b
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_s_rkr_solver_bld
|
||||
end subroutine amg_s_krm_solver_bld
|
||||
end interface
|
||||
|
||||
|
||||
@@ -187,12 +190,12 @@ contains
|
||||
|
||||
!
|
||||
!
|
||||
subroutine s_rkr_solver_default(sv)
|
||||
subroutine s_krm_solver_default(sv)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_s_krm_solver_type), intent(inout) :: sv
|
||||
|
||||
sv%method = 'bicgstab'
|
||||
sv%kprec = 'bjac'
|
||||
@@ -207,42 +210,42 @@ contains
|
||||
sv%global = .false.
|
||||
|
||||
return
|
||||
end subroutine s_rkr_solver_default
|
||||
end subroutine s_krm_solver_default
|
||||
|
||||
function s_rkr_solver_get_nzeros(sv) result(val)
|
||||
function s_krm_solver_get_nzeros(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_s_rkr_solver_type), intent(in) :: sv
|
||||
class(amg_s_krm_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = sv%prec%get_nzeros()
|
||||
|
||||
return
|
||||
end function s_rkr_solver_get_nzeros
|
||||
end function s_krm_solver_get_nzeros
|
||||
|
||||
function s_rkr_solver_sizeof(sv) result(val)
|
||||
function s_krm_solver_sizeof(sv) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_s_rkr_solver_type), intent(in) :: sv
|
||||
class(amg_s_krm_solver_type), intent(in) :: sv
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = sv%prec%sizeof() + sv%desc_local%sizeof() + sv%a_local%sizeof()
|
||||
|
||||
return
|
||||
end function s_rkr_solver_sizeof
|
||||
end function s_krm_solver_sizeof
|
||||
|
||||
|
||||
subroutine s_rkr_solver_check(sv,info)
|
||||
subroutine s_krm_solver_check(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_s_krm_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_rkr_solver_check'
|
||||
character(len=20) :: name='s_krm_solver_check'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -256,36 +259,36 @@ contains
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine s_rkr_solver_check
|
||||
end subroutine s_krm_solver_check
|
||||
|
||||
subroutine s_rkr_solver_cseti(sv,what,val,info,idx)
|
||||
subroutine s_krm_solver_cseti(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_s_krm_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_rkr_solver_cseti'
|
||||
character(len=20) :: name='s_krm_solver_cseti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('RKR_IRST')
|
||||
case('KRM_IRST')
|
||||
sv%irst = val
|
||||
case('RKR_ISTOPC')
|
||||
case('KRM_ISTOPC')
|
||||
sv%istopc = val
|
||||
case('RKR_ITMAX')
|
||||
case('KRM_ITMAX')
|
||||
sv%itmax = val
|
||||
case('RKR_ITRACE')
|
||||
case('KRM_ITRACE')
|
||||
sv%itrace = val
|
||||
case('RKR_SUB_SOLVE')
|
||||
case('KRM_SUB_SOLVE')
|
||||
sv%i_sub_solve = val
|
||||
case('RKR_FILLIN')
|
||||
case('KRM_FILLIN')
|
||||
sv%fillin = val
|
||||
case default
|
||||
call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
|
||||
@@ -296,33 +299,33 @@ contains
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_rkr_solver_cseti
|
||||
end subroutine s_krm_solver_cseti
|
||||
|
||||
subroutine s_rkr_solver_csetc(sv,what,val,info,idx)
|
||||
subroutine s_krm_solver_csetc(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_s_krm_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='s_rkr_solver_csetc'
|
||||
character(len=20) :: name='s_krm_solver_csetc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('RKR_METHOD')
|
||||
case('KRM_METHOD')
|
||||
sv%method = psb_toupper(trim(val))
|
||||
case('RKR_KPREC')
|
||||
case('KRM_KPREC')
|
||||
sv%kprec = psb_toupper(trim(val))
|
||||
case('RKR_SUB_SOLVE')
|
||||
case('KRM_SUB_SOLVE')
|
||||
sv%sub_solve = psb_toupper(trim(val))
|
||||
case('RKR_GLOBAL')
|
||||
case('KRM_GLOBAL')
|
||||
select case(psb_toupper(trim(val)))
|
||||
case('LOCAL','FALSE')
|
||||
sv%global = .false.
|
||||
@@ -345,26 +348,26 @@ contains
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_rkr_solver_csetc
|
||||
end subroutine s_krm_solver_csetc
|
||||
|
||||
subroutine s_rkr_solver_csetr(sv,what,val,info,idx)
|
||||
subroutine s_krm_solver_csetr(sv,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_s_krm_solver_type), intent(inout) :: sv
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_rkr_solver_csetr'
|
||||
character(len=20) :: name='s_krm_solver_csetr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('RKR_EPS')
|
||||
case('KRM_EPS')
|
||||
sv%eps = val
|
||||
case default
|
||||
call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
|
||||
@@ -375,18 +378,18 @@ contains
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_rkr_solver_csetr
|
||||
end subroutine s_krm_solver_csetr
|
||||
|
||||
subroutine s_rkr_solver_clear_data(sv,info)
|
||||
subroutine s_krm_solver_clear_data(sv,info)
|
||||
use psb_base_mod, only : psb_exit
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_s_krm_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
type(psb_ctxt_type) :: l_ctxt
|
||||
character(len=20) :: name='s_rkr_solver_free'
|
||||
character(len=20) :: name='s_krm_solver_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -403,19 +406,19 @@ contains
|
||||
nullify(sv%a)
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
end subroutine s_rkr_solver_clear_data
|
||||
end subroutine s_krm_solver_clear_data
|
||||
|
||||
|
||||
subroutine s_rkr_solver_free(sv,info)
|
||||
subroutine s_krm_solver_free(sv,info)
|
||||
use psb_base_mod, only : psb_exit
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_s_krm_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
type(psb_ctxt_type) :: l_ctxt
|
||||
character(len=20) :: name='s_rkr_solver_free'
|
||||
character(len=20) :: name='s_krm_solver_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -424,29 +427,31 @@ contains
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
end subroutine s_rkr_solver_free
|
||||
end subroutine s_krm_solver_free
|
||||
|
||||
function s_rkr_solver_get_fmt() result(val)
|
||||
function s_krm_solver_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "RKR solver"
|
||||
end function s_rkr_solver_get_fmt
|
||||
val = "KRM solver"
|
||||
end function s_krm_solver_get_fmt
|
||||
|
||||
subroutine s_rkr_solver_descr(sv,info,iout,coarse)
|
||||
subroutine s_krm_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_rkr_solver_type), intent(in) :: sv
|
||||
class(amg_s_krm_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_s_rkr_solver_descr'
|
||||
character(len=20), parameter :: name='amg_s_krm_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -455,34 +460,33 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (sv%global) then
|
||||
write(iout_,*) ' Recursive Krylov solver (global)'
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (global)'
|
||||
else
|
||||
write(iout_,*) ' Recursive Krylov solver (local) '
|
||||
write(iout_,*) trim(prefix_), ' Krylov solver (local) '
|
||||
end if
|
||||
write(iout_,*) ' method: ',sv%method
|
||||
write(iout_,*) ' kprec: ',sv%kprec
|
||||
if (sv%i_sub_solve > 0) then
|
||||
write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
|
||||
else
|
||||
write(iout_,*) ' sub_solve: ',sv%sub_solve
|
||||
end if
|
||||
write(iout_,*) ' itmax: ',sv%itmax
|
||||
write(iout_,*) ' eps: ',sv%eps
|
||||
write(iout_,*) ' fillin: ',sv%fillin
|
||||
|
||||
write(iout_,*) trim(prefix_), ' method: ',sv%method
|
||||
write(iout_,*) trim(prefix_), ' kprec: ',sv%kprec
|
||||
call sv%prec%descr(info,iout_,prefix='KRM : '//prefix_)
|
||||
write(iout_,*) trim(prefix_), ' itmax: ',sv%itmax
|
||||
write(iout_,*) trim(prefix_), ' eps: ',sv%eps
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_rkr_solver_descr
|
||||
end subroutine s_krm_solver_descr
|
||||
|
||||
subroutine s_rkr_solver_cnv(sv,info,amold,vmold,imold)
|
||||
subroutine s_krm_solver_cnv(sv,info,amold,vmold,imold)
|
||||
implicit none
|
||||
class(amg_s_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_s_krm_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
@@ -490,13 +494,13 @@ contains
|
||||
|
||||
call sv%prec%cnv(info,amold=amold,vmold=vmold,imold=imold)
|
||||
|
||||
end subroutine s_rkr_solver_cnv
|
||||
end subroutine s_krm_solver_cnv
|
||||
|
||||
subroutine s_rkr_solver_clone(sv,svout,info)
|
||||
subroutine s_krm_solver_clone(sv,svout,info)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_s_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
@@ -505,7 +509,7 @@ contains
|
||||
call svout%free(info)
|
||||
allocate(svout,stat=info,mold=sv)
|
||||
select type(so=>svout)
|
||||
class is(amg_s_rkr_solver_type)
|
||||
class is(amg_s_krm_solver_type)
|
||||
so%method = sv%method
|
||||
so%kprec = sv%kprec
|
||||
so%sub_solve = sv%sub_solve
|
||||
@@ -524,21 +528,21 @@ contains
|
||||
info = psb_err_internal_error_
|
||||
end select
|
||||
|
||||
end subroutine s_rkr_solver_clone
|
||||
end subroutine s_krm_solver_clone
|
||||
|
||||
|
||||
subroutine s_rkr_solver_clone_settings(sv,svout,info)
|
||||
subroutine s_krm_solver_clone_settings(sv,svout,info)
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_rkr_solver_type), intent(inout) :: sv
|
||||
class(amg_s_krm_solver_type), intent(inout) :: sv
|
||||
class(amg_s_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select type(so=>svout)
|
||||
class is(amg_s_rkr_solver_type)
|
||||
class is(amg_s_krm_solver_type)
|
||||
so%method = sv%method
|
||||
so%kprec = sv%kprec
|
||||
so%sub_solve = sv%sub_solve
|
||||
@@ -554,11 +558,11 @@ contains
|
||||
info = psb_err_internal_error_
|
||||
end select
|
||||
|
||||
end subroutine s_rkr_solver_clone_settings
|
||||
end subroutine s_krm_solver_clone_settings
|
||||
|
||||
subroutine s_rkr_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
|
||||
subroutine s_krm_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
|
||||
implicit none
|
||||
class(amg_s_rkr_solver_type), intent(in) :: sv
|
||||
class(amg_s_krm_solver_type), intent(in) :: sv
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -568,23 +572,23 @@ contains
|
||||
|
||||
call sv%prec%dump(info,prefix=prefix,head=head)
|
||||
|
||||
end subroutine s_rkr_solver_dmp
|
||||
end subroutine s_krm_solver_dmp
|
||||
!
|
||||
! Notify whether RKR is used as a global solver
|
||||
! Notify whether KRM is used as a global solver
|
||||
!
|
||||
function s_rkr_solver_is_global(sv) result(val)
|
||||
function s_krm_solver_is_global(sv) result(val)
|
||||
implicit none
|
||||
class(amg_s_rkr_solver_type), intent(in) :: sv
|
||||
class(amg_s_krm_solver_type), intent(in) :: sv
|
||||
logical :: val
|
||||
|
||||
val = (sv%global)
|
||||
end function s_rkr_solver_is_global
|
||||
end function s_krm_solver_is_global
|
||||
!
|
||||
function s_rkr_solver_is_iterative() result(val)
|
||||
function s_krm_solver_is_iterative() result(val)
|
||||
implicit none
|
||||
logical :: val
|
||||
|
||||
val = .true.
|
||||
end function s_rkr_solver_is_iterative
|
||||
end function s_krm_solver_is_iterative
|
||||
|
||||
end module amg_s_rkr_solver
|
||||
end module amg_s_krm_solver
|
||||
File diff suppressed because it is too large
Load Diff
@@ -3,9 +3,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -78,7 +78,8 @@ module amg_s_mumps_solver
|
||||
!
|
||||
! Controls to be set before MUMPS instantiation:
|
||||
!
|
||||
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: LOCAL 1==amg_global_solver_: GLOBAL
|
||||
! IPAR(1) : MUMPS_LOC_GLOB 0==amg_local_solver_: 'LOCAL_SOLVER
|
||||
! 1==amg_global_solver_: 'GLOBAL_SOLVER'
|
||||
! IPAR(2) : MUMPS_PRINT_ERR print verbosity (see MUMPS)
|
||||
! IPAR(3) : MUMPS_SYM 0: non-symmetric 2: symmetric
|
||||
integer(psb_ipk_), dimension(3) :: ipar
|
||||
@@ -313,22 +314,24 @@ subroutine s_mumps_solver_finalize(sv)
|
||||
|
||||
end subroutine s_mumps_solver_finalize
|
||||
|
||||
subroutine s_mumps_solver_descr(sv,info,iout,coarse)
|
||||
subroutine s_mumps_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_mumps_solver_type), intent(in) :: sv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: me, np
|
||||
character(len=20), parameter :: name='amg_z_mumps_solver_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -337,8 +340,13 @@ subroutine s_mumps_solver_descr(sv,info,iout,coarse)
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) ' MUMPS Solver. '
|
||||
write(iout_,*) trim(prefix_), ' MUMPS Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
+336
-164
@@ -1,15 +1,15 @@
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Fabio Durastante
|
||||
!
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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:
|
||||
@@ -21,7 +21,7 @@
|
||||
! 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
|
||||
@@ -33,22 +33,22 @@
|
||||
! 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.
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
! File: amg_s_onelev_mod.f90
|
||||
!
|
||||
! Module: amg_s_onelev_mod
|
||||
!
|
||||
! This module defines:
|
||||
! This module defines:
|
||||
! - the amg_s_onelev_type data structure containing one level
|
||||
! of a multilevel preconditioner and related
|
||||
! data structures;
|
||||
!
|
||||
! It contains routines for
|
||||
! - Building and applying;
|
||||
! - Building and applying;
|
||||
! - checking if the preconditioner is correctly defined;
|
||||
! - printing a description of the preconditioner;
|
||||
! - deallocating the preconditioner data structure.
|
||||
! - deallocating the preconditioner data structure.
|
||||
!
|
||||
|
||||
module amg_s_onelev_mod
|
||||
@@ -56,6 +56,8 @@ module amg_s_onelev_mod
|
||||
use amg_base_prec_type
|
||||
use amg_s_base_smoother_mod
|
||||
use amg_s_dec_aggregator_mod
|
||||
use amg_s_parmatch_aggregator_mod
|
||||
|
||||
use psb_base_mod, only : psb_sspmat_type, psb_s_vect_type, &
|
||||
& psb_s_base_vect_type, psb_lsspmat_type, psb_slinmap_type, psb_spk_, &
|
||||
& psb_ipk_, psb_epk_, psb_lpk_, psb_desc_type, psb_i_base_vect_type, &
|
||||
@@ -73,16 +75,16 @@ module amg_s_onelev_mod
|
||||
! class(amg_s_base_smoother_type), pointer :: sm2 => null()
|
||||
! class(amg_smlprec_wrk_type), allocatable :: wrk
|
||||
! class(amg_s_base_aggregator_type), allocatable :: aggr
|
||||
! type(amg_sml_parms) :: parms
|
||||
! type(amg_sml_parms) :: parms
|
||||
! type(psb_sspmat_type) :: ac
|
||||
! type(psb_sesc_type) :: desc_ac
|
||||
! type(psb_sspmat_type), pointer :: base_a => null()
|
||||
! type(psb_desc_type), pointer :: base_desc => null()
|
||||
! type(psb_sspmat_type), pointer :: base_a => null()
|
||||
! type(psb_desc_type), pointer :: base_desc => null()
|
||||
! type(psb_slinmap_type) :: map
|
||||
! end type amg_sonelev_type
|
||||
!
|
||||
! Note that s denotes the kind of the real data type to be chosen
|
||||
! according to single/double precision version of MLD2P4.
|
||||
! according to single/double precision version of AMG4PSBLAS.
|
||||
!
|
||||
! sm,sm2a - class(amg_s_base_smoother_type), allocatable
|
||||
! The current level pre- and post-smooother.
|
||||
@@ -93,7 +95,7 @@ module amg_s_onelev_mod
|
||||
! Workspace for application of preconditioner; may be
|
||||
! pre-allocated to save time in the application within a
|
||||
! Krylov solver.
|
||||
! aggr - class(amg_s_base_aggregator_type), allocatable
|
||||
! aggr - class(amg_s_base_aggregator_type), allocatable
|
||||
! The aggregator object: holds the algorithmic choices and
|
||||
! (possibly) additional data for building the aggregation.
|
||||
! parms - type(amg_sml_parms)
|
||||
@@ -104,7 +106,7 @@ module amg_s_onelev_mod
|
||||
! The communication descriptor associated to the matrix
|
||||
! stored in ac.
|
||||
! base_a - type(psb_sspmat_type), pointer.
|
||||
! Pointer (really a pointer!) to the local part of the current
|
||||
! 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.
|
||||
@@ -115,13 +117,13 @@ module amg_s_onelev_mod
|
||||
! vector spaces associated to the index spaces of the previous
|
||||
! and current levels.
|
||||
!
|
||||
! Methods:
|
||||
! 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.
|
||||
! then calls the descr() method of the smoother object.
|
||||
!
|
||||
! descr - Prints a description of the object.
|
||||
! default - Set default values
|
||||
@@ -130,14 +132,14 @@ module amg_s_onelev_mod
|
||||
! it is passed to the smoother object for further processing.
|
||||
! check - Sanity checks.
|
||||
! sizeof - Total memory occupation in bytes
|
||||
! get_nzeros - Number of nonzeros
|
||||
! get_nzeros - Number of nonzeros
|
||||
! get_wrksz - How many workspace vector does apply_vect need
|
||||
! allocate_wrk - Allocate auxiliary workspace
|
||||
! free_wrk - Free auxiliary workspace
|
||||
! bld_tprol - Invoke the aggr method to build the tentative prolongator
|
||||
! mat_asb - Build the final (possibly smoothed) prolongator and coarse matrix.
|
||||
! mat_asb - Build the final (possibly smoothed) prolongator and coarse matrix.
|
||||
!
|
||||
!
|
||||
!
|
||||
type amg_smlprec_wrk_type
|
||||
real(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
|
||||
type(psb_s_vect_type) :: vtx, vty, vx2l, vy2l
|
||||
@@ -148,25 +150,35 @@ module amg_s_onelev_mod
|
||||
procedure, pass(wk) :: clone => s_wrk_clone
|
||||
procedure, pass(wk) :: move_alloc => s_wrk_move_alloc
|
||||
procedure, pass(wk) :: cnv => s_wrk_cnv
|
||||
procedure, pass(wk) :: sizeof => s_wrk_sizeof
|
||||
procedure, pass(wk) :: sizeof => s_wrk_sizeof
|
||||
end type amg_smlprec_wrk_type
|
||||
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
|
||||
|
||||
type amg_s_remap_data_type
|
||||
type(psb_sspmat_type) :: ac_pre_remap
|
||||
type(psb_desc_type) :: desc_ac_pre_remap
|
||||
integer(psb_ipk_) :: idest
|
||||
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
|
||||
contains
|
||||
procedure, pass(rmp) :: clone => s_remap_data_clone
|
||||
end type amg_s_remap_data_type
|
||||
|
||||
type amg_s_onelev_type
|
||||
class(amg_s_base_smoother_type), allocatable :: sm, sm2a
|
||||
class(amg_s_base_smoother_type), pointer :: sm2 => null()
|
||||
class(amg_smlprec_wrk_type), allocatable :: wrk
|
||||
class(amg_s_base_aggregator_type), allocatable :: aggr
|
||||
type(amg_sml_parms) :: parms
|
||||
type(amg_sml_parms) :: parms
|
||||
type(psb_sspmat_type) :: ac
|
||||
integer(psb_ipk_) :: ac_nz_loc
|
||||
integer(psb_lpk_) :: ac_nz_tot
|
||||
type(psb_desc_type) :: desc_ac
|
||||
type(psb_sspmat_type), pointer :: base_a => null()
|
||||
type(psb_desc_type), pointer :: base_desc => null()
|
||||
type(psb_sspmat_type), pointer :: base_a => null()
|
||||
type(psb_desc_type), pointer :: base_desc => null()
|
||||
type(psb_lsspmat_type) :: tprol
|
||||
type(psb_slinmap_type) :: map
|
||||
type(psb_slinmap_type) :: linmap
|
||||
type(amg_s_remap_data_type) :: remap_data
|
||||
real(psb_spk_) :: szratio
|
||||
contains
|
||||
procedure, pass(lv) :: bld_tprol => s_base_onelev_bld_tprol
|
||||
@@ -176,8 +188,10 @@ module amg_s_onelev_mod
|
||||
procedure, pass(lv) :: clone => s_base_onelev_clone
|
||||
procedure, pass(lv) :: cnv => amg_s_base_onelev_cnv
|
||||
procedure, pass(lv) :: descr => amg_s_base_onelev_descr
|
||||
procedure, pass(lv) :: memory_use => amg_s_base_onelev_memory_use
|
||||
procedure, pass(lv) :: default => s_base_onelev_default
|
||||
procedure, pass(lv) :: free => amg_s_base_onelev_free
|
||||
procedure, pass(lv) :: free_smoothers => amg_s_base_onelev_free_smoothers
|
||||
procedure, pass(lv) :: nullify => s_base_onelev_nullify
|
||||
procedure, pass(lv) :: check => amg_s_base_onelev_check
|
||||
procedure, pass(lv) :: dump => amg_s_base_onelev_dump
|
||||
@@ -187,7 +201,7 @@ module amg_s_onelev_mod
|
||||
procedure, pass(lv) :: setsm => amg_s_base_onelev_setsm
|
||||
procedure, pass(lv) :: setsv => amg_s_base_onelev_setsv
|
||||
procedure, pass(lv) :: setag => amg_s_base_onelev_setag
|
||||
generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag
|
||||
generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag
|
||||
procedure, pass(lv) :: sizeof => s_base_onelev_sizeof
|
||||
procedure, pass(lv) :: get_nzeros => s_base_onelev_get_nzeros
|
||||
procedure, pass(lv) :: get_wrksz => s_base_onelev_get_wrksize
|
||||
@@ -195,7 +209,14 @@ module amg_s_onelev_mod
|
||||
procedure, pass(lv) :: free_wrk => s_base_onelev_free_wrk
|
||||
procedure, nopass :: stringval => amg_stringval
|
||||
procedure, pass(lv) :: move_alloc => s_base_onelev_move_alloc
|
||||
|
||||
|
||||
|
||||
procedure, pass(lv) :: map_rstr_a => amg_s_base_onelev_map_rstr_a
|
||||
procedure, pass(lv) :: map_prol_a => amg_s_base_onelev_map_prol_a
|
||||
procedure, pass(lv) :: map_rstr_v => amg_s_base_onelev_map_rstr_v
|
||||
procedure, pass(lv) :: map_prol_v => amg_s_base_onelev_map_prol_v
|
||||
generic, public :: map_rstr => map_rstr_a, map_rstr_v
|
||||
generic, public :: map_prol => map_prol_a, map_prol_v
|
||||
end type amg_s_onelev_type
|
||||
|
||||
type amg_s_onelev_node
|
||||
@@ -209,11 +230,11 @@ module amg_s_onelev_mod
|
||||
& s_base_onelev_get_wrksize, s_base_onelev_allocate_wrk, &
|
||||
& s_base_onelev_free_wrk
|
||||
|
||||
interface
|
||||
interface
|
||||
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
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
@@ -238,141 +259,172 @@ module amg_s_onelev_mod
|
||||
end subroutine amg_s_base_onelev_build
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout)
|
||||
interface
|
||||
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
|
||||
! Arguments
|
||||
class(amg_s_onelev_type), intent(in) :: lv
|
||||
integer(psb_ipk_), intent(in) :: il,nl,ilmin
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
class(amg_s_onelev_type), intent(in) :: lv
|
||||
integer(psb_ipk_), intent(in) :: il,nl,ilmin
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_s_base_onelev_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
interface
|
||||
subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
|
||||
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
|
||||
! Arguments
|
||||
class(amg_s_onelev_type), intent(in) :: lv
|
||||
integer(psb_ipk_), intent(in) :: il,nl,ilmin
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: global
|
||||
end subroutine amg_s_base_onelev_memory_use
|
||||
end interface
|
||||
|
||||
interface
|
||||
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
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_s_base_onelev_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_base_onelev_free
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
class(amg_s_onelev_type), intent(inout) :: lv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_base_onelev_free_smoothers
|
||||
end interface
|
||||
|
||||
interface
|
||||
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
|
||||
! Arguments
|
||||
class(amg_s_onelev_type), intent(inout) :: lv
|
||||
class(amg_s_onelev_type), intent(inout) :: lv
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_base_onelev_check
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
|
||||
! 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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
end subroutine amg_s_base_onelev_setsm
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
|
||||
! 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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
end subroutine amg_s_base_onelev_setsv
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
|
||||
! 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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
end subroutine amg_s_base_onelev_setag
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
|
||||
! Arguments
|
||||
class(amg_s_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
class(amg_s_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_s_base_onelev_cseti
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
! Arguments
|
||||
class(amg_s_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
class(amg_s_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_s_base_onelev_csetc
|
||||
end interface
|
||||
|
||||
interface
|
||||
|
||||
interface
|
||||
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
|
||||
|
||||
class(amg_s_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
|
||||
class(amg_s_onelev_type), intent(inout) :: lv
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
@@ -380,13 +432,13 @@ interface
|
||||
end subroutine amg_s_base_onelev_csetr
|
||||
end interface
|
||||
|
||||
interface
|
||||
interface
|
||||
subroutine amg_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
|
||||
& 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
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
@@ -394,15 +446,62 @@ interface
|
||||
logical, optional, intent(in) :: ac, rp, smoother, solver, tprol, global_num
|
||||
end subroutine amg_s_base_onelev_dump
|
||||
end interface
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_s_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
|
||||
import
|
||||
implicit none
|
||||
class(amg_s_onelev_type), target, intent(inout) :: lv
|
||||
real(psb_spk_), intent(in) :: alpha, beta
|
||||
real(psb_spk_), intent(inout) :: u(:)
|
||||
real(psb_spk_), intent(out) :: v(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_spk_), optional :: work(:)
|
||||
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)
|
||||
import
|
||||
implicit none
|
||||
class(amg_s_onelev_type), target, intent(inout) :: lv
|
||||
real(psb_spk_), intent(in) :: alpha, beta
|
||||
type(psb_s_vect_type), intent(inout) :: vect_u, vect_v
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_spk_), optional :: work(:)
|
||||
type(psb_s_vect_type), optional, target, intent(inout) :: vtx,vty
|
||||
end subroutine amg_s_base_onelev_map_rstr_v
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
|
||||
import
|
||||
implicit none
|
||||
class(amg_s_onelev_type), target, intent(inout) :: lv
|
||||
real(psb_spk_), intent(in) :: alpha, beta
|
||||
real(psb_spk_), intent(inout) :: u(:)
|
||||
real(psb_spk_), intent(out) :: v(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_spk_), optional :: work(:)
|
||||
|
||||
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)
|
||||
import
|
||||
implicit none
|
||||
class(amg_s_onelev_type), target, intent(inout) :: lv
|
||||
real(psb_spk_), intent(in) :: alpha, beta
|
||||
type(psb_s_vect_type), intent(inout) :: vect_u, vect_v
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
real(psb_spk_), optional :: work(:)
|
||||
type(psb_s_vect_type), optional, target, intent(inout) :: vtx,vty
|
||||
end subroutine amg_s_base_onelev_map_prol_v
|
||||
end interface
|
||||
|
||||
contains
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
|
||||
function s_base_onelev_get_nzeros(lv) result(val)
|
||||
implicit none
|
||||
implicit none
|
||||
class(amg_s_onelev_type), intent(in) :: lv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
@@ -414,16 +513,16 @@ contains
|
||||
end function s_base_onelev_get_nzeros
|
||||
|
||||
function s_base_onelev_sizeof(lv) result(val)
|
||||
implicit none
|
||||
implicit none
|
||||
class(amg_s_onelev_type), intent(in) :: lv
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
|
||||
val = psb_sizeof_ip+psb_sizeof_lp
|
||||
val = val + lv%desc_ac%sizeof()
|
||||
val = val + lv%ac%sizeof()
|
||||
val = val + lv%tprol%sizeof()
|
||||
val = val + lv%map%sizeof()
|
||||
val = val + lv%linmap%sizeof()
|
||||
if (allocated(lv%sm)) val = val + lv%sm%sizeof()
|
||||
if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof()
|
||||
if (allocated(lv%aggr)) val = val + lv%aggr%sizeof()
|
||||
@@ -432,19 +531,19 @@ contains
|
||||
|
||||
|
||||
subroutine s_base_onelev_nullify(lv)
|
||||
implicit none
|
||||
implicit none
|
||||
|
||||
class(amg_s_onelev_type), intent(inout) :: lv
|
||||
|
||||
nullify(lv%base_a)
|
||||
nullify(lv%base_desc)
|
||||
nullify(lv%base_a)
|
||||
nullify(lv%base_desc)
|
||||
nullify(lv%sm2)
|
||||
end subroutine s_base_onelev_nullify
|
||||
|
||||
!
|
||||
! Multilevel defaults:
|
||||
! Multilevel defaults:
|
||||
! multiplicative vs. additive ML framework;
|
||||
! Smoothed decoupled aggregation with zero threshold;
|
||||
! Smoothed decoupled aggregation with zero threshold;
|
||||
! distributed coarse matrix;
|
||||
! damping omega computed with the max-norm estimate of the
|
||||
! dominant eigenvalue;
|
||||
@@ -454,10 +553,10 @@ contains
|
||||
subroutine s_base_onelev_default(lv)
|
||||
|
||||
Implicit None
|
||||
|
||||
|
||||
! Arguments
|
||||
class(amg_s_onelev_type), target, intent(inout) :: lv
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
lv%parms%sweeps_pre = 1
|
||||
lv%parms%sweeps_post = 1
|
||||
@@ -472,7 +571,7 @@ contains
|
||||
lv%parms%aggr_filter = amg_no_filter_mat_
|
||||
lv%parms%aggr_omega_val = szero
|
||||
lv%parms%aggr_thresh = 0.01_psb_spk_
|
||||
|
||||
|
||||
if (allocated(lv%sm)) call lv%sm%default()
|
||||
if (allocated(lv%sm2a)) then
|
||||
call lv%sm2a%default()
|
||||
@@ -482,7 +581,7 @@ contains
|
||||
end if
|
||||
if (.not.allocated(lv%aggr)) allocate(amg_s_dec_aggregator_type :: lv%aggr,stat=info)
|
||||
if (allocated(lv%aggr)) call lv%aggr%default()
|
||||
|
||||
|
||||
return
|
||||
|
||||
end subroutine s_base_onelev_default
|
||||
@@ -497,9 +596,9 @@ contains
|
||||
type(psb_lsspmat_type), intent(out) :: t_prol
|
||||
type(amg_saggr_data), intent(in) :: ag_data
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
call lv%aggr%bld_tprol(lv%parms,ag_data,a,desc_a,ilaggr,nlaggr,t_prol,info)
|
||||
|
||||
|
||||
end subroutine s_base_onelev_bld_tprol
|
||||
|
||||
|
||||
@@ -509,7 +608,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
call lv%aggr%update_next(lvnext%aggr,info)
|
||||
|
||||
|
||||
end subroutine s_base_onelev_update_aggr
|
||||
|
||||
|
||||
@@ -518,33 +617,33 @@ contains
|
||||
Implicit None
|
||||
|
||||
! 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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(lv%sm)) then
|
||||
if (allocated(lv%sm)) then
|
||||
call lv%sm%clone(lvout%sm,info)
|
||||
else
|
||||
if (allocated(lvout%sm)) then
|
||||
else
|
||||
if (allocated(lvout%sm)) then
|
||||
call lvout%sm%free(info)
|
||||
if (info==psb_success_) deallocate(lvout%sm,stat=info)
|
||||
end if
|
||||
end if
|
||||
if (allocated(lv%sm2a)) then
|
||||
if (allocated(lv%sm2a)) then
|
||||
call lv%sm%clone(lvout%sm2a,info)
|
||||
lvout%sm2 => lvout%sm2a
|
||||
else
|
||||
if (allocated(lvout%sm2a)) then
|
||||
else
|
||||
if (allocated(lvout%sm2a)) then
|
||||
call lvout%sm2a%free(info)
|
||||
if (info==psb_success_) deallocate(lvout%sm2a,stat=info)
|
||||
end if
|
||||
lvout%sm2 => lvout%sm
|
||||
end if
|
||||
if (allocated(lv%aggr)) then
|
||||
if (allocated(lv%aggr)) then
|
||||
call lv%aggr%clone(lvout%aggr,info)
|
||||
else
|
||||
if (allocated(lvout%aggr)) then
|
||||
if (allocated(lvout%aggr)) then
|
||||
call lvout%aggr%free(info)
|
||||
if (info==psb_success_) deallocate(lvout%aggr,stat=info)
|
||||
end if
|
||||
@@ -553,10 +652,11 @@ contains
|
||||
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
|
||||
if (info == psb_success_) call lv%tprol%clone(lvout%tprol,info)
|
||||
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
|
||||
if (info == psb_success_) call lv%map%clone(lvout%map,info)
|
||||
if (info == psb_success_) call lv%linmap%clone(lvout%linmap,info)
|
||||
if (info == psb_success_) call lv%remap_data%clone(lvout%remap_data,info)
|
||||
lvout%base_a => lv%base_a
|
||||
lvout%base_desc => lv%base_desc
|
||||
|
||||
|
||||
return
|
||||
|
||||
end subroutine s_base_onelev_clone
|
||||
@@ -565,12 +665,12 @@ contains
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(amg_s_onelev_type), target, intent(inout) :: lv, b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
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
|
||||
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
|
||||
@@ -581,18 +681,18 @@ contains
|
||||
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%map,b%map,info)
|
||||
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)
|
||||
implicit none
|
||||
implicit none
|
||||
class(amg_s_onelev_type), intent(inout) :: lv
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
@@ -613,44 +713,54 @@ contains
|
||||
select case(lv%parms%ml_cycle)
|
||||
case(amg_add_ml_,amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
|
||||
! We're good
|
||||
|
||||
|
||||
case(amg_kcycle_ml_, amg_kcyclesym_ml_)
|
||||
!
|
||||
! We need 7 in inneritkcycle.
|
||||
! Can we reuse vtx?
|
||||
!
|
||||
! Can we reuse vtx?
|
||||
!
|
||||
val = val + 7
|
||||
|
||||
|
||||
case default
|
||||
! Need a better error signaling ?
|
||||
val = -1
|
||||
end select
|
||||
|
||||
|
||||
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
|
||||
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) call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
|
||||
|
||||
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_), intent(out) :: info
|
||||
!
|
||||
integer(psb_ipk_) :: nwv,i
|
||||
integer(psb_ipk_) :: nwv,i
|
||||
info = psb_success_
|
||||
|
||||
if (allocated(lv%wrk)) then
|
||||
@@ -658,46 +768,88 @@ contains
|
||||
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)
|
||||
|
||||
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
|
||||
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)
|
||||
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,&
|
||||
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)
|
||||
end do
|
||||
|
||||
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_), intent(out) :: info
|
||||
!
|
||||
integer(psb_ipk_) :: i
|
||||
info = psb_success_
|
||||
@@ -718,7 +870,7 @@ contains
|
||||
end if
|
||||
|
||||
end subroutine s_wrk_free
|
||||
|
||||
|
||||
subroutine s_wrk_clone(wk,wkout,info)
|
||||
use psb_base_mod
|
||||
Implicit None
|
||||
@@ -726,11 +878,11 @@ contains
|
||||
! 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_), 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)
|
||||
@@ -752,12 +904,12 @@ contains
|
||||
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
|
||||
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
call b%free(info)
|
||||
call move_alloc(wk%tx,b%tx)
|
||||
call move_alloc(wk%ty,b%ty)
|
||||
@@ -770,17 +922,17 @@ contains
|
||||
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
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
!
|
||||
integer(psb_ipk_) :: i
|
||||
@@ -801,7 +953,7 @@ contains
|
||||
|
||||
function s_wrk_sizeof(wk) result(val)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
implicit none
|
||||
class(amg_smlprec_wrk_type), intent(in) :: wk
|
||||
integer(psb_epk_) :: val
|
||||
integer :: i
|
||||
@@ -820,5 +972,25 @@ contains
|
||||
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
|
||||
|
||||
@@ -0,0 +1,691 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
! moved here from amg4psblas-extension
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS Extensions
|
||||
!
|
||||
! (C) Copyright 2019
|
||||
!
|
||||
! Salvatore Filippone Cranfield University
|
||||
! Pasqua D'Ambra IAC-CNR, Naples, IT
|
||||
!
|
||||
! 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
|
||||
!
|
||||
!
|
||||
! 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
|
||||
!
|
||||
!
|
||||
|
||||
module amg_s_parmatch_aggregator_mod
|
||||
use amg_s_base_aggregator_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
|
||||
integer(psb_ipk_) :: matching_alg
|
||||
integer(psb_ipk_) :: n_sweeps ! When n_sweeps >1 we need an auxiliary descriptor
|
||||
integer(psb_ipk_) :: orig_aggr_size
|
||||
integer(psb_ipk_) :: jacobi_sweeps
|
||||
real(psb_spk_), allocatable :: w(:), w_nxt(:)
|
||||
type(psb_sspmat_type), allocatable :: prol, restr
|
||||
type(psb_sspmat_type), allocatable :: ac, base_a, rwa
|
||||
type(psb_desc_type), allocatable :: desc_ac, desc_ax, base_desc, rwdesc
|
||||
logical :: reproducible_matching = .false.
|
||||
logical :: need_symmetrize = .false.
|
||||
logical :: unsmoothed_hierarchy = .true.
|
||||
contains
|
||||
procedure, pass(ag) :: bld_tprol => amg_s_parmatch_aggregator_build_tprol
|
||||
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) :: inner_mat_asb => amg_s_parmatch_aggregator_inner_mat_asb
|
||||
procedure, pass(ag) :: bld_map => amg_s_parmatch_aggregator_bld_map
|
||||
procedure, pass(ag) :: csetc => amg_s_parmatch_aggr_csetc
|
||||
procedure, pass(ag) :: cseti => amg_s_parmatch_aggr_cseti
|
||||
procedure, pass(ag) :: default => amg_s_parmatch_aggr_set_default
|
||||
procedure, pass(ag) :: sizeof => amg_s_parmatch_aggregator_sizeof
|
||||
procedure, pass(ag) :: update_next => amg_s_parmatch_aggregator_update_next
|
||||
procedure, pass(ag) :: bld_wnxt => amg_s_parmatch_bld_wnxt
|
||||
procedure, pass(ag) :: bld_default_w => amg_s_bld_default_w
|
||||
procedure, pass(ag) :: set_c_default_w => amg_s_set_prm_c_default_w
|
||||
procedure, pass(ag) :: descr => amg_s_parmatch_aggregator_descr
|
||||
procedure, pass(ag) :: clone => amg_s_parmatch_aggregator_clone
|
||||
procedure, pass(ag) :: free => amg_s_parmatch_aggregator_free
|
||||
procedure, nopass :: fmt => amg_s_parmatch_aggregator_fmt
|
||||
procedure, nopass :: xt_desc => amg_s_parmatch_aggregator_xt_desc
|
||||
end type amg_s_parmatch_aggregator_type
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
& a,desc_a,ilaggr,nlaggr,t_prol,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(amg_saggr_data), intent(in) :: ag_data
|
||||
type(psb_sspmat_type), intent(inout) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
|
||||
type(psb_lsspmat_type), intent(out) :: t_prol
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_aggregator_build_tprol
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
|
||||
implicit none
|
||||
class(amg_s_parmatch_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(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(psb_lsspmat_type), intent(inout) :: t_prol
|
||||
type(psb_sspmat_type), intent(out) :: op_prol,ac,op_restr
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_aggregator_mat_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
|
||||
& ac,desc_ac, op_prol,op_restr,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
|
||||
implicit none
|
||||
class(amg_s_parmatch_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(inout) :: desc_a
|
||||
type(psb_sspmat_type), intent(inout) :: op_prol,ac,op_restr
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_aggregator_mat_asb
|
||||
end interface
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_aggregator_inner_mat_asb(ag,parms,a,desc_a,&
|
||||
& ac,desc_ac, op_prol,op_restr,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
|
||||
implicit none
|
||||
class(amg_s_parmatch_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
|
||||
type(psb_sspmat_type), intent(inout) :: op_prol,op_restr
|
||||
type(psb_sspmat_type), intent(inout) :: ac
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_aggregator_inner_mat_asb
|
||||
end interface
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_spmm_bld(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_lsspmat_type), intent(inout) :: t_prol
|
||||
type(psb_sspmat_type), intent(inout) :: ac, op_prol, op_restr
|
||||
type(psb_desc_type), intent(out) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_spmm_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_unsmth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: dol1smoothing
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_lsspmat_type), intent(inout) :: t_prol
|
||||
type(psb_sspmat_type), intent(inout) :: op_prol,ac, op_restr
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_unsmth_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_smth_bld(dol1smoothing,ag,a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: dol1smoothing
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(psb_sspmat_type), intent(in) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_lsspmat_type), intent(inout) :: t_prol
|
||||
type(psb_sspmat_type), intent(inout) :: op_prol,ac, op_restr
|
||||
type(psb_desc_type), intent(inout) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_smth_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data
|
||||
implicit none
|
||||
type(psb_sspmat_type), intent(inout) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_lsspmat_type), intent(inout) :: t_prol
|
||||
type(psb_sspmat_type), intent(inout) :: op_prol,ac, op_restr
|
||||
type(psb_desc_type), intent(out) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_spmm_bld_ov
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_parmatch_spmm_bld_inner(a,desc_a,ilaggr,nlaggr,parms,&
|
||||
& ac,desc_ac,op_prol,op_restr,t_prol,info)
|
||||
import :: amg_s_parmatch_aggregator_type, psb_desc_type, psb_sspmat_type,&
|
||||
& psb_lsspmat_type, psb_dpk_, psb_ipk_, psb_lpk_, amg_sml_parms, amg_saggr_data,&
|
||||
& psb_s_csr_sparse_mat, psb_ls_csr_sparse_mat
|
||||
implicit none
|
||||
type(psb_s_csr_sparse_mat), intent(inout) :: a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(amg_sml_parms), intent(inout) :: parms
|
||||
type(psb_lsspmat_type), intent(inout) :: t_prol
|
||||
type(psb_sspmat_type), intent(inout) :: op_prol,ac, op_restr
|
||||
type(psb_desc_type), intent(out) :: desc_ac
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_parmatch_spmm_bld_inner
|
||||
end interface
|
||||
|
||||
private :: is_legal_malg, is_legal_csize, is_legal_nsweeps, is_legal_nlevels
|
||||
|
||||
contains
|
||||
|
||||
subroutine amg_s_bld_default_w(ag,nr)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
integer(psb_ipk_), intent(in) :: nr
|
||||
integer(psb_ipk_) :: info
|
||||
call psb_realloc(nr,ag%w,info)
|
||||
if (info /= psb_success_) return
|
||||
ag%w = done
|
||||
!call ag%set_c_default_w()
|
||||
end subroutine amg_s_bld_default_w
|
||||
|
||||
subroutine amg_s_set_prm_c_default_w(ag)
|
||||
use psb_realloc_mod
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
!write(0,*) 'prm_c_deafult_w '
|
||||
call psb_safe_ab_cpy(ag%w,ag%w_nxt,info)
|
||||
|
||||
end subroutine amg_s_set_prm_c_default_w
|
||||
|
||||
subroutine amg_s_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
integer(psb_lpk_), intent(in) :: ilaggr(:)
|
||||
real(psb_spk_), intent(in) :: valaggr(:)
|
||||
integer(psb_ipk_), intent(in) :: nx
|
||||
|
||||
integer(psb_ipk_) :: info,i,j
|
||||
|
||||
! The vector was already fixed in the call to BCMatch.
|
||||
!write(0,*) 'Executing bld_wnxt ',nx
|
||||
call psb_realloc(nx,ag%w_nxt,info)
|
||||
|
||||
end subroutine amg_s_parmatch_bld_wnxt
|
||||
|
||||
function amg_s_parmatch_aggregator_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Parallel Matching aggregation"
|
||||
end function amg_s_parmatch_aggregator_fmt
|
||||
|
||||
function amg_s_parmatch_aggregator_xt_desc() result(val)
|
||||
implicit none
|
||||
logical :: val
|
||||
|
||||
val = .true.
|
||||
end function amg_s_parmatch_aggregator_xt_desc
|
||||
|
||||
function amg_s_parmatch_aggregator_sizeof(ag) result(val)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), intent(in) :: ag
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = 4
|
||||
val = val + psb_size(ag%w) + psb_size(ag%w_nxt)
|
||||
if (allocated(ag%ac)) val = val + ag%ac%sizeof()
|
||||
if (allocated(ag%base_a)) val = val + ag%base_a%sizeof()
|
||||
if (allocated(ag%prol)) val = val + ag%prol%sizeof()
|
||||
if (allocated(ag%restr)) val = val + ag%restr%sizeof()
|
||||
if (allocated(ag%desc_ac)) val = val + ag%desc_ac%sizeof()
|
||||
if (allocated(ag%base_desc)) val = val + ag%base_desc%sizeof()
|
||||
if (allocated(ag%desc_ax)) val = val + ag%desc_ax%sizeof()
|
||||
|
||||
end function amg_s_parmatch_aggregator_sizeof
|
||||
|
||||
subroutine amg_s_parmatch_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Parallel Matching Aggregator'
|
||||
write(iout,*) trim(prefix_),' ',' Number of matching sweeps: ',ag%n_sweeps
|
||||
write(iout,*) trim(prefix_),' ',' Matching algorithm : MatchBoxP (PREIS)'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
|
||||
return
|
||||
end subroutine amg_s_parmatch_aggregator_descr
|
||||
|
||||
function is_legal_malg(alg) result(val)
|
||||
logical :: val
|
||||
integer(psb_ipk_) :: alg
|
||||
|
||||
val = (0==alg)
|
||||
end function is_legal_malg
|
||||
|
||||
function is_legal_csize(csize) result(val)
|
||||
logical :: val
|
||||
integer(psb_ipk_) :: csize
|
||||
|
||||
val = ((-1==csize).or.(csize >0))
|
||||
end function is_legal_csize
|
||||
|
||||
function is_legal_nsweeps(nsw) result(val)
|
||||
logical :: val
|
||||
integer(psb_ipk_) :: nsw
|
||||
|
||||
val = (1<=nsw)
|
||||
end function is_legal_nsweeps
|
||||
|
||||
function is_legal_nlevels(nlv) result(val)
|
||||
logical :: val
|
||||
integer(psb_ipk_) :: nlv
|
||||
|
||||
val = (1<=nlv)
|
||||
end function is_legal_nlevels
|
||||
|
||||
|
||||
subroutine amg_s_parmatch_aggregator_update_next(ag,agnext,info)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
class(amg_s_base_aggregator_type), target, intent(inout) :: agnext
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!
|
||||
!
|
||||
select type(agnext)
|
||||
class is (amg_s_parmatch_aggregator_type)
|
||||
if (.not.is_legal_malg(agnext%matching_alg)) &
|
||||
& agnext%matching_alg = ag%matching_alg
|
||||
if (.not.is_legal_nsweeps(agnext%n_sweeps))&
|
||||
& agnext%n_sweeps = ag%n_sweeps
|
||||
!!$ if (.not.is_legal_csize(agnext%max_csize))&
|
||||
!!$ & agnext%max_csize = ag%max_csize
|
||||
!!$ if (.not.is_legal_nlevels(agnext%max_nlevels))&
|
||||
!!$ & agnext%max_nlevels = ag%max_nlevels
|
||||
! Is this going to generate shallow copies/memory leaks/double frees?
|
||||
! To be investigated further.
|
||||
call psb_safe_ab_cpy(ag%w_nxt,agnext%w,info)
|
||||
call agnext%set_c_default_w()
|
||||
if (ag%unsmoothed_hierarchy) then
|
||||
agnext%unsmoothed_hierarchy = .true.
|
||||
call move_alloc(ag%rwdesc,agnext%base_desc)
|
||||
call move_alloc(ag%rwa,agnext%base_a)
|
||||
end if
|
||||
|
||||
class default
|
||||
! What should we do here?
|
||||
end select
|
||||
info = 0
|
||||
end subroutine amg_s_parmatch_aggregator_update_next
|
||||
|
||||
subroutine amg_s_parmatch_aggr_csetc(ag,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, iwhat
|
||||
character(len=20) :: name='s_parmatch_aggr_cseti'
|
||||
info = psb_success_
|
||||
|
||||
! For now we ignore IDX
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('PRMC_REPRODUCIBLE_MATCHING')
|
||||
select case(psb_toupper(trim(val)))
|
||||
case('F','FALSE')
|
||||
ag%reproducible_matching = .false.
|
||||
case('REPRODUCIBLE','TRUE','T')
|
||||
ag%reproducible_matching =.true.
|
||||
end select
|
||||
case('PRMC_NEED_SYMMETRIZE')
|
||||
select case(psb_toupper(trim(val)))
|
||||
case('FALSE','F')
|
||||
ag%need_symmetrize = .false.
|
||||
case('SYMMETRIZE','TRUE','T')
|
||||
ag%need_symmetrize =.true.
|
||||
end select
|
||||
case('PRMC_UNSMOOTHED_HIERARCHY')
|
||||
select case(psb_toupper(trim(val)))
|
||||
case('F','FALSE')
|
||||
ag%unsmoothed_hierarchy = .false.
|
||||
case('T','TRUE')
|
||||
ag%unsmoothed_hierarchy =.true.
|
||||
end select
|
||||
case default
|
||||
! Do nothing
|
||||
end select
|
||||
return
|
||||
end subroutine amg_s_parmatch_aggr_csetc
|
||||
|
||||
subroutine amg_s_parmatch_aggr_cseti(ag,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
integer(psb_ipk_) :: err_act, iwhat
|
||||
character(len=20) :: name='s_parmatch_aggr_cseti'
|
||||
info = psb_success_
|
||||
|
||||
! For now we ignore IDX
|
||||
|
||||
select case(psb_toupper(trim(what)))
|
||||
case('PRMC_MATCH_ALG')
|
||||
ag%matching_alg=val
|
||||
case('PRMC_SWEEPS')
|
||||
ag%n_sweeps=val
|
||||
case('AGGR_SIZE')
|
||||
ag%orig_aggr_size = val
|
||||
ag%n_sweeps=max(1,ceiling(log(val*1.0)/log(2.0)))
|
||||
case('PRMC_W_SIZE')
|
||||
call ag%bld_default_w(val)
|
||||
case('PRMC_REPRODUCIBLE_MATCHING')
|
||||
ag%reproducible_matching = (val == 1)
|
||||
case('PRMC_NEED_SYMMETRIZE')
|
||||
ag%need_symmetrize = (val == 1)
|
||||
case('PRMC_UNSMOOTHED_HIERARCHY')
|
||||
ag%unsmoothed_hierarchy = (val == 1)
|
||||
case default
|
||||
! Do nothing
|
||||
end select
|
||||
return
|
||||
end subroutine amg_s_parmatch_aggr_cseti
|
||||
|
||||
subroutine amg_s_parmatch_aggr_set_default(ag)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
|
||||
character(len=20) :: name='s_parmatch_aggr_set_default'
|
||||
call ag%amg_s_base_aggregator_type%default()
|
||||
ag%matching_alg = 0
|
||||
ag%n_sweeps = 1
|
||||
ag%jacobi_sweeps = 0
|
||||
!!$ ag%max_nlevels = 36
|
||||
!!$ ag%max_csize = -1
|
||||
!
|
||||
! Apparently BootCMatch works better
|
||||
! by keeping all entries
|
||||
!
|
||||
ag%do_clean_zeros = .false.
|
||||
|
||||
return
|
||||
|
||||
end subroutine amg_s_parmatch_aggr_set_default
|
||||
|
||||
subroutine amg_s_parmatch_aggregator_free(ag,info)
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
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%prol)) then
|
||||
call ag%prol%free(); deallocate(ag%prol,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%restr)) then
|
||||
call ag%restr%free(); deallocate(ag%restr,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%ac)) then
|
||||
call ag%ac%free(); deallocate(ag%ac,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%base_a)) then
|
||||
call ag%base_a%free(); deallocate(ag%base_a,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%rwa)) then
|
||||
call ag%rwa%free(); deallocate(ag%rwa,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%desc_ac)) then
|
||||
call ag%desc_ac%free(info); deallocate(ag%desc_ac,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%desc_ax)) then
|
||||
call ag%desc_ax%free(info); deallocate(ag%desc_ax,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%base_desc)) then
|
||||
call ag%base_desc%free(info); deallocate(ag%base_desc,stat=info)
|
||||
end if
|
||||
if ((info == 0).and.allocated(ag%rwdesc)) then
|
||||
call ag%rwdesc%free(info); deallocate(ag%rwdesc,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine amg_s_parmatch_aggregator_free
|
||||
|
||||
subroutine amg_s_parmatch_aggregator_clone(ag,agnext,info)
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
|
||||
class(amg_s_base_aggregator_type), allocatable, intent(inout) :: agnext
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = 0
|
||||
if (allocated(agnext)) then
|
||||
call agnext%free(info)
|
||||
if (info == 0) deallocate(agnext,stat=info)
|
||||
end if
|
||||
if (info /= 0) return
|
||||
allocate(agnext,source=ag,stat=info)
|
||||
select type(agnext)
|
||||
class is (amg_s_parmatch_aggregator_type)
|
||||
call agnext%set_c_default_w()
|
||||
class default
|
||||
! Should never ever get here
|
||||
info = -1
|
||||
end select
|
||||
end subroutine amg_s_parmatch_aggregator_clone
|
||||
|
||||
subroutine amg_s_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
& op_restr,op_prol,map,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
type(psb_desc_type), intent(in), target :: desc_a, desc_ac
|
||||
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
|
||||
type(psb_sspmat_type), intent(inout) :: op_prol, op_restr
|
||||
type(psb_slinmap_type), intent(out) :: map
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_parmatch_aggregator_bld_map'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
!
|
||||
! Copy the prolongation/restriction matrices into the descriptor map.
|
||||
! op_restr => PR^T i.e. restriction operator
|
||||
! op_prol => PR i.e. prolongation operator
|
||||
!
|
||||
! For parmatch have an explicit copy of the descriptors
|
||||
!
|
||||
if (allocated(ag%desc_ax)) then
|
||||
!!$ write(0,*) 'Building linmap with ag%desc_ax ',ag%desc_ax%get_local_rows(),ag%desc_ax%get_local_cols(),&
|
||||
!!$ & desc_ac%get_local_rows(),desc_ac%get_local_cols()
|
||||
map = psb_linmap(psb_map_gen_linear_,ag%desc_ax,&
|
||||
& desc_ac,op_restr,op_prol,ilaggr,nlaggr)
|
||||
else
|
||||
map = psb_linmap(psb_map_gen_linear_,desc_a,&
|
||||
& desc_ac,op_restr,op_prol,ilaggr,nlaggr)
|
||||
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)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
end subroutine amg_s_parmatch_aggregator_bld_map
|
||||
#endif
|
||||
end module amg_s_parmatch_aggregator_mod
|
||||
@@ -0,0 +1,374 @@
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
! Daniela di Serafino
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
!
|
||||
!
|
||||
! File: amg_s_poly_smoother_mod.f90
|
||||
!
|
||||
! Module: amg_s_poly_smoother_mod
|
||||
!
|
||||
! This module defines:
|
||||
! the amg_s_poly_smoother_type data structure containing the
|
||||
! smoother for a Jacobi/block Jacobi smoother.
|
||||
! The smoother stores in ND the block off-diagonal matrix.
|
||||
! One special case is treated separately, when the solver is DIAG or L1-DIAG
|
||||
! then the ND is the entire off-diagonal part of the matrix (including the
|
||||
! main diagonal block), so that it becomes possible to implement
|
||||
! a pure Jacobi or L1-Jacobi global solver.
|
||||
!
|
||||
module amg_s_poly_smoother
|
||||
use amg_s_base_smoother_mod
|
||||
use amg_d_poly_coeff_mod
|
||||
|
||||
type, extends(amg_s_base_smoother_type) :: amg_s_poly_smoother_type
|
||||
! The local solver component is inherited from the
|
||||
! parent type.
|
||||
! class(amg_s_base_solver_type), allocatable :: sv
|
||||
!
|
||||
integer(psb_ipk_) :: pdegree, variant
|
||||
integer(psb_ipk_) :: rho_estimate=amg_poly_rho_est_power_
|
||||
integer(psb_ipk_) :: rho_estimate_iterations=10
|
||||
type(psb_sspmat_type), pointer :: pa => null()
|
||||
real(psb_spk_), allocatable :: poly_beta(:)
|
||||
real(psb_spk_) :: cf_a = szero
|
||||
real(psb_spk_) :: rho_ba = -sone
|
||||
contains
|
||||
procedure, pass(sm) :: apply_v => amg_s_poly_smoother_apply_vect
|
||||
!!$ procedure, pass(sm) :: apply_a => amg_s_poly_smoother_apply
|
||||
procedure, pass(sm) :: dump => amg_s_poly_smoother_dmp
|
||||
procedure, pass(sm) :: build => amg_s_poly_smoother_bld
|
||||
procedure, pass(sm) :: cnv => amg_s_poly_smoother_cnv
|
||||
procedure, pass(sm) :: clone => amg_s_poly_smoother_clone
|
||||
procedure, pass(sm) :: clone_settings => amg_s_poly_smoother_clone_settings
|
||||
procedure, pass(sm) :: clear_data => amg_s_poly_smoother_clear_data
|
||||
procedure, pass(sm) :: free => s_poly_smoother_free
|
||||
procedure, pass(sm) :: cseti => amg_s_poly_smoother_cseti
|
||||
procedure, pass(sm) :: csetc => amg_s_poly_smoother_csetc
|
||||
procedure, pass(sm) :: csetr => amg_s_poly_smoother_csetr
|
||||
procedure, pass(sm) :: descr => amg_s_poly_smoother_descr
|
||||
procedure, pass(sm) :: sizeof => s_poly_smoother_sizeof
|
||||
procedure, pass(sm) :: default => s_poly_smoother_default
|
||||
procedure, pass(sm) :: get_nzeros => s_poly_smoother_get_nzeros
|
||||
procedure, pass(sm) :: get_wrksz => s_poly_smoother_get_wrksize
|
||||
procedure, nopass :: get_fmt => s_poly_smoother_get_fmt
|
||||
procedure, nopass :: get_id => s_poly_smoother_get_id
|
||||
end type amg_s_poly_smoother_type
|
||||
private :: s_poly_smoother_free, &
|
||||
& s_poly_smoother_sizeof, s_poly_smoother_get_nzeros, &
|
||||
& s_poly_smoother_get_fmt, s_poly_smoother_get_id, &
|
||||
& s_poly_smoother_get_wrksize
|
||||
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
& sweeps,work,wv,info,init,initu)
|
||||
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_ipk_
|
||||
|
||||
type(psb_desc_type), intent(in) :: desc_data
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
type(psb_s_vect_type),intent(inout) :: x
|
||||
type(psb_s_vect_type),intent(inout) :: y
|
||||
real(psb_spk_),intent(in) :: alpha,beta
|
||||
character(len=1),intent(in) :: trans
|
||||
integer(psb_ipk_), intent(in) :: sweeps
|
||||
real(psb_spk_),target, intent(inout) :: work(:)
|
||||
type(psb_s_vect_type),intent(inout) :: wv(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: init
|
||||
type(psb_s_vect_type),intent(inout), optional :: initu
|
||||
end subroutine amg_s_poly_smoother_apply_vect
|
||||
end interface
|
||||
|
||||
!!$ interface
|
||||
!!$ subroutine amg_s_poly_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
!!$ & sweeps,work,info,init,initu)
|
||||
!!$ 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_ipk_
|
||||
!!$ type(psb_desc_type), intent(in) :: desc_data
|
||||
!!$ class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
!!$ real(psb_spk_),intent(inout) :: x(:)
|
||||
!!$ real(psb_spk_),intent(inout) :: y(:)
|
||||
!!$ real(psb_spk_),intent(in) :: alpha,beta
|
||||
!!$ character(len=1),intent(in) :: trans
|
||||
!!$ integer(psb_ipk_), intent(in) :: sweeps
|
||||
!!$ real(psb_spk_),target, intent(inout) :: work(:)
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ character, intent(in), optional :: init
|
||||
!!$ real(psb_spk_),intent(inout), optional :: initu(:)
|
||||
!!$ end subroutine amg_s_poly_smoother_apply
|
||||
!!$ end interface
|
||||
!!$
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
|
||||
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_ipk_, psb_i_base_vect_type
|
||||
type(psb_sspmat_type), intent(in), target :: a
|
||||
Type(psb_desc_type), Intent(inout) :: desc_a
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_s_poly_smoother_bld
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_cnv(sm,info,amold,vmold,imold)
|
||||
import :: amg_s_poly_smoother_type, psb_spk_, &
|
||||
& psb_s_base_sparse_mat, psb_s_base_vect_type,&
|
||||
& psb_ipk_, psb_i_base_vect_type
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_s_base_sparse_mat), intent(in), optional :: amold
|
||||
class(psb_s_base_vect_type), intent(in), optional :: vmold
|
||||
class(psb_i_base_vect_type), intent(in), optional :: imold
|
||||
end subroutine amg_s_poly_smoother_cnv
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
|
||||
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
|
||||
& psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, &
|
||||
& psb_ipk_
|
||||
implicit none
|
||||
class(amg_s_poly_smoother_type), intent(in) :: sm
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer(psb_ipk_), intent(in) :: level
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix, head
|
||||
logical, optional, intent(in) :: smoother, solver, global_num
|
||||
end subroutine amg_s_poly_smoother_dmp
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_clone(sm,smout,info)
|
||||
import :: amg_s_poly_smoother_type, psb_spk_, &
|
||||
& amg_s_base_smoother_type, psb_ipk_
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
class(amg_s_base_smoother_type), allocatable, intent(inout) :: smout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_poly_smoother_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_clone_settings(sm,smout,info)
|
||||
import :: amg_s_poly_smoother_type, psb_spk_, &
|
||||
& amg_s_base_smoother_type, psb_ipk_
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
class(amg_s_base_smoother_type), intent(inout) :: smout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_poly_smoother_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_clear_data(sm,info)
|
||||
import :: amg_s_poly_smoother_type, psb_spk_, &
|
||||
& amg_s_base_smoother_type, psb_ipk_
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_s_poly_smoother_clear_data
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
import :: amg_s_poly_smoother_type, psb_ipk_
|
||||
class(amg_s_poly_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_s_poly_smoother_descr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_cseti(sm,what,val,info,idx)
|
||||
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
|
||||
& psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
|
||||
implicit none
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_s_poly_smoother_cseti
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_csetc(sm,what,val,info,idx)
|
||||
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
|
||||
& psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
|
||||
implicit none
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_s_poly_smoother_csetc
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_s_poly_smoother_csetr(sm,what,val,info,idx)
|
||||
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
|
||||
& psb_spk_, amg_s_poly_smoother_type, psb_epk_, psb_desc_type, psb_ipk_
|
||||
implicit none
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: idx
|
||||
end subroutine amg_s_poly_smoother_csetr
|
||||
end interface
|
||||
|
||||
|
||||
contains
|
||||
|
||||
|
||||
subroutine s_poly_smoother_free(sm,info)
|
||||
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_poly_smoother_free'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
|
||||
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%free(info)
|
||||
if (info == psb_success_) deallocate(sm%sv,stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
end if
|
||||
if (allocated(sm%poly_beta)) deallocate(sm%poly_beta)
|
||||
sm%pa => null()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
end subroutine s_poly_smoother_free
|
||||
|
||||
function s_poly_smoother_sizeof(sm) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_s_poly_smoother_type), intent(in) :: sm
|
||||
integer(psb_epk_) :: val
|
||||
|
||||
val = psb_sizeof_dp
|
||||
if (allocated(sm%sv)) val = val + sm%sv%sizeof()
|
||||
if (allocated(sm%poly_beta)) val = val + psb_sizeof_dp * size(sm%poly_beta)
|
||||
|
||||
return
|
||||
end function s_poly_smoother_sizeof
|
||||
|
||||
subroutine s_poly_smoother_default(sm)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
|
||||
!
|
||||
! Default: BJAC with no residual check
|
||||
!
|
||||
sm%pdegree = 1
|
||||
sm%rho_ba = -sone
|
||||
sm%variant = amg_cheb_4_
|
||||
sm%rho_estimate = amg_poly_rho_est_power_
|
||||
sm%rho_estimate_iterations = 20
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%default()
|
||||
end if
|
||||
|
||||
return
|
||||
end subroutine s_poly_smoother_default
|
||||
|
||||
function s_poly_smoother_get_nzeros(sm) result(val)
|
||||
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_s_poly_smoother_type), intent(in) :: sm
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
val = 0
|
||||
if (allocated(sm%sv)) val = val + sm%sv%get_nzeros()
|
||||
|
||||
return
|
||||
end function s_poly_smoother_get_nzeros
|
||||
|
||||
function s_poly_smoother_get_wrksize(sm) result(val)
|
||||
implicit none
|
||||
class(amg_s_poly_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = 4
|
||||
if (allocated(sm%sv)) val = val + sm%sv%get_wrksz()
|
||||
|
||||
end function s_poly_smoother_get_wrksize
|
||||
|
||||
function s_poly_smoother_get_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Polynomial smoother"
|
||||
end function s_poly_smoother_get_fmt
|
||||
|
||||
function s_poly_smoother_get_id() result(val)
|
||||
implicit none
|
||||
integer(psb_ipk_) :: val
|
||||
|
||||
val = amg_poly_
|
||||
end function s_poly_smoother_get_id
|
||||
|
||||
|
||||
end module amg_s_poly_smoother
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -40,7 +40,7 @@
|
||||
! Module: amg_s_prec_mod
|
||||
!
|
||||
! This module defines the user interfaces to the real/complex, single/double
|
||||
! precision versions of the user-level MLD2P4 routines.
|
||||
! precision versions of the user-level AMG4PSBLAS routines.
|
||||
!
|
||||
module amg_s_prec_mod
|
||||
|
||||
@@ -55,12 +55,7 @@ module amg_s_prec_mod
|
||||
use amg_s_ainv_solver
|
||||
use amg_s_invk_solver
|
||||
use amg_s_invt_solver
|
||||
|
||||
interface amg_precset
|
||||
module procedure amg_s_iprecsetsm, amg_s_iprecsetsv, &
|
||||
& amg_s_cprecseti, amg_s_cprecsetc, amg_s_cprecsetr, &
|
||||
& amg_s_iprecsetag
|
||||
end interface amg_precset
|
||||
use amg_s_krm_solver
|
||||
|
||||
interface amg_extprol_bld
|
||||
subroutine amg_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
|
||||
@@ -82,61 +77,4 @@ module amg_s_prec_mod
|
||||
end subroutine amg_s_extprol_bld
|
||||
end interface amg_extprol_bld
|
||||
|
||||
contains
|
||||
|
||||
subroutine amg_s_iprecsetsm(p,val,info,pos)
|
||||
type(amg_sprec_type), intent(inout) :: p
|
||||
class(amg_s_base_smoother_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(val,info,pos=pos)
|
||||
end subroutine amg_s_iprecsetsm
|
||||
|
||||
subroutine amg_s_iprecsetsv(p,val,info,pos)
|
||||
type(amg_sprec_type), intent(inout) :: p
|
||||
class(amg_s_base_solver_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
call p%set(val,info, pos=pos)
|
||||
end subroutine amg_s_iprecsetsv
|
||||
|
||||
subroutine amg_s_iprecsetag(p,val,info,pos)
|
||||
type(amg_sprec_type), intent(inout) :: p
|
||||
class(amg_s_base_aggregator_type), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
call p%set(val,info, pos=pos)
|
||||
end subroutine amg_s_iprecsetag
|
||||
|
||||
subroutine amg_s_cprecseti(p,what,val,info,pos)
|
||||
type(amg_sprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_s_cprecseti
|
||||
|
||||
subroutine amg_s_cprecsetr(p,what,val,info,pos)
|
||||
type(amg_sprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_s_cprecsetr
|
||||
|
||||
subroutine amg_s_cprecsetc(p,what,val,info,pos)
|
||||
type(amg_sprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), optional, intent(in) :: pos
|
||||
|
||||
call p%set(what,val,info,pos=pos)
|
||||
end subroutine amg_s_cprecsetc
|
||||
|
||||
end module amg_s_prec_mod
|
||||
|
||||
+124
-17
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -66,7 +66,7 @@ module amg_s_prec_type
|
||||
!
|
||||
! This is the data type containing all the information about the multilevel
|
||||
! preconditioner ('d', 's', 'c' and 'z', according to the real/complex,
|
||||
! single/double precision version of MLD2P4).
|
||||
! single/double precision version of AMG4PSBLAS).
|
||||
! It consists of an array of 'one-level' intermediate data structures
|
||||
! of type amg_sonelev_type, each containing the information needed to apply
|
||||
! the smoothing and the coarse-space correction at a generic level. RT is the
|
||||
@@ -135,8 +135,11 @@ module amg_s_prec_type
|
||||
procedure, pass(prec) :: build => amg_sprecbld
|
||||
procedure, pass(prec) :: hierarchy_build => amg_s_hierarchy_bld
|
||||
procedure, pass(prec) :: hierarchy_rebuild => amg_s_hierarchy_rebld
|
||||
procedure, pass(prec) :: hierarchy_free => amg_s_hierarchy_free
|
||||
procedure, pass(prec) :: smoothers_build => amg_s_smoothers_bld
|
||||
procedure, pass(prec) :: smoothers_free => amg_s_smoothers_free
|
||||
procedure, pass(prec) :: descr => amg_sfile_prec_descr
|
||||
procedure, pass(prec) :: memory_use => amg_sfile_prec_memory_use
|
||||
end type amg_sprec_type
|
||||
|
||||
private :: amg_s_dump, amg_s_get_compl, amg_s_cmp_compl,&
|
||||
@@ -155,16 +158,35 @@ module amg_s_prec_type
|
||||
|
||||
|
||||
interface amg_precdescr
|
||||
subroutine amg_sfile_prec_descr(prec,iout,root)
|
||||
subroutine amg_sfile_prec_descr(prec,info,iout,root,verbosity,prefix)
|
||||
import :: amg_sprec_type, psb_ipk_
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_sprec_type), intent(in) :: prec
|
||||
class(amg_sprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_sfile_prec_descr
|
||||
end interface
|
||||
|
||||
|
||||
interface amg_memory_use
|
||||
subroutine amg_sfile_prec_memory_use(prec,info,iout,root,verbosity,prefix,global)
|
||||
import :: amg_sprec_type, psb_ipk_
|
||||
implicit none
|
||||
! Arguments
|
||||
class(amg_sprec_type), intent(in) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
integer(psb_ipk_), intent(in), optional :: root
|
||||
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
logical, intent(in), optional :: global
|
||||
end subroutine amg_sfile_prec_memory_use
|
||||
end interface
|
||||
|
||||
interface amg_sizeof
|
||||
module procedure amg_sprec_sizeof
|
||||
end interface
|
||||
@@ -342,6 +364,14 @@ module amg_s_prec_type
|
||||
end subroutine amg_s_smoothers_bld
|
||||
end interface amg_smoothers_bld
|
||||
|
||||
interface amg_smoothers_free
|
||||
module procedure amg_s_smoothers_free
|
||||
end interface amg_smoothers_free
|
||||
|
||||
interface amg_hierarchy_free
|
||||
module procedure amg_s_hierarchy_free
|
||||
end interface amg_hierarchy_free
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning a pointer to the smoother
|
||||
@@ -424,11 +454,22 @@ contains
|
||||
end if
|
||||
end function amg_s_get_nzeros
|
||||
|
||||
function amg_sprec_sizeof(prec) result(val)
|
||||
function amg_sprec_sizeof(prec, global) result(val)
|
||||
implicit none
|
||||
class(amg_sprec_type), intent(in) :: prec
|
||||
integer(psb_epk_) :: val
|
||||
logical, intent(in), optional :: global
|
||||
integer(psb_epk_) :: val
|
||||
integer(psb_ipk_) :: i
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
|
||||
logical :: global_
|
||||
|
||||
if (present(global)) then
|
||||
global_ = global
|
||||
else
|
||||
global_ = .false.
|
||||
end if
|
||||
|
||||
val = 0
|
||||
val = val + psb_sizeof_ip
|
||||
if (allocated(prec%precv)) then
|
||||
@@ -436,6 +477,11 @@ contains
|
||||
val = val + prec%precv(i)%sizeof()
|
||||
end do
|
||||
end if
|
||||
if (global_) then
|
||||
ctxt = prec%ctxt
|
||||
call psb_sum(ctxt,val)
|
||||
end if
|
||||
|
||||
end function amg_sprec_sizeof
|
||||
|
||||
!
|
||||
@@ -599,6 +645,68 @@ contains
|
||||
|
||||
end subroutine amg_s_prec_free
|
||||
|
||||
subroutine amg_s_smoothers_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_sprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_s_smoothers_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
if (allocated(prec%precv)) then
|
||||
do i=1,size(prec%precv)
|
||||
call prec%precv(i)%free_smoothers(info)
|
||||
end do
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_s_smoothers_free
|
||||
|
||||
subroutine amg_s_hierarchy_free(prec,info)
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(amg_sprec_type), intent(inout) :: prec
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: me,err_act,i
|
||||
character(len=20) :: name
|
||||
|
||||
info=psb_success_
|
||||
name = 'amg_s_hierarchy_free'
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_; goto 9999
|
||||
end if
|
||||
|
||||
me=-1
|
||||
write(0,*) 'Missing implementation '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine amg_s_hierarchy_free
|
||||
|
||||
|
||||
!
|
||||
@@ -738,16 +846,15 @@ contains
|
||||
character(len=*), intent(in), optional :: prefix, head
|
||||
logical, optional, intent(in) :: smoother, solver,ac, rp, tprol, global_num
|
||||
integer(psb_ipk_) :: i, j, il1, iln, lev
|
||||
type(psb_ctxt_type) :: icontxt
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: iam, np, iproc_
|
||||
character(len=80) :: prefix_
|
||||
character(len=120) :: fname ! len should be at least 20 more than
|
||||
! len of prefix_
|
||||
|
||||
info = 0
|
||||
icontxt = prec%ctxt
|
||||
call psb_info(icontxt,iam,np)
|
||||
|
||||
ctxt = prec%ctxt
|
||||
call psb_info(ctxt,iam,np)
|
||||
iln = size(prec%precv)
|
||||
if (present(istart)) then
|
||||
il1 = max(1,istart)
|
||||
@@ -812,13 +919,13 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
! Local vars
|
||||
integer(psb_ipk_) :: i, j, ln, lev
|
||||
type(psb_ctxt_type) :: icontxt
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: iam, np
|
||||
|
||||
info = psb_success_
|
||||
select type(pout => precout)
|
||||
class is (amg_sprec_type)
|
||||
pout%ctxt = prec%ctxt
|
||||
pout%ctxt = prec%ctxt
|
||||
pout%ag_data = prec%ag_data
|
||||
pout%outer_sweeps = prec%outer_sweeps
|
||||
if (allocated(prec%precv)) then
|
||||
@@ -834,8 +941,8 @@ contains
|
||||
if (info == psb_success_) then
|
||||
pout%precv(lev)%base_a => pout%precv(lev)%ac
|
||||
pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
|
||||
pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
|
||||
pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
|
||||
pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
|
||||
pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
|
||||
end if
|
||||
end do
|
||||
end if
|
||||
@@ -875,8 +982,8 @@ contains
|
||||
do i=2, size(b%precv)
|
||||
b%precv(i)%base_a => b%precv(i)%ac
|
||||
b%precv(i)%base_desc => b%precv(i)%desc_ac
|
||||
b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
|
||||
b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
|
||||
b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
|
||||
b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -385,20 +385,22 @@ contains
|
||||
|
||||
end subroutine s_slu_solver_finalize
|
||||
|
||||
subroutine s_slu_solver_descr(sv,info,iout,coarse)
|
||||
subroutine s_slu_solver_descr(sv,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_s_slu_solver_type), intent(in) :: sv
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer :: err_act
|
||||
character(len=20), parameter :: name='amg_s_slu_solver_descr'
|
||||
integer :: iout_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -407,8 +409,13 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout_,*) ' SuperLU Sparse Factorization Solver. '
|
||||
write(iout_,*) trim(prefix_), ' SuperLU Sparse Factorization Solver. '
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -88,16 +88,25 @@ contains
|
||||
val = "Symmetric Decoupled aggregation"
|
||||
end function amg_s_symdec_aggregator_fmt
|
||||
|
||||
subroutine amg_s_symdec_aggregator_descr(ag,parms,iout,info)
|
||||
subroutine amg_s_symdec_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
implicit none
|
||||
class(amg_s_symdec_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
write(iout,*) 'Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
character(1024) :: prefix_
|
||||
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) trim(prefix_),' ','Decoupled Aggregator locally-symmetrized'
|
||||
write(iout,*) trim(prefix_),' ','Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
|
||||
return
|
||||
end subroutine amg_s_symdec_aggregator_descr
|
||||
|
||||
@@ -1,11 +1,14 @@
|
||||
!
|
||||
!
|
||||
! AMG-AINV: Approximate Inverse plugin for
|
||||
!
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
!
|
||||
! Salvatore Filippone University of Rome Tor Vergata
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! 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
|
||||
@@ -55,13 +58,10 @@ module amg_z_ainv_solver
|
||||
procedure, pass(sv) :: check => amg_z_ainv_solver_check
|
||||
procedure, pass(sv) :: build => amg_z_ainv_solver_bld
|
||||
procedure, pass(sv) :: clone => amg_z_ainv_solver_clone
|
||||
procedure, pass(sv) :: clone_settings => amg_z_ainv_solver_clone_settings
|
||||
procedure, pass(sv) :: cseti => amg_z_ainv_solver_cseti
|
||||
procedure, pass(sv) :: csetc => amg_z_ainv_solver_csetc
|
||||
procedure, pass(sv) :: csetr => amg_z_ainv_solver_csetr
|
||||
procedure, pass(sv) :: seti => amg_z_ainv_solver_seti
|
||||
procedure, pass(sv) :: setc => amg_z_ainv_solver_setc
|
||||
procedure, pass(sv) :: setr => amg_z_ainv_solver_setr
|
||||
generic, public :: set => seti, setr, setc
|
||||
procedure, pass(sv) :: descr => amg_z_ainv_solver_descr
|
||||
procedure, pass(sv) :: default => z_ainv_solver_default
|
||||
procedure, nopass :: stringval => z_ainv_stringval
|
||||
@@ -83,6 +83,16 @@ module amg_z_ainv_solver
|
||||
end subroutine amg_z_ainv_solver_clone
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_ainv_solver_clone_settings(sv,svout,info)
|
||||
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
|
||||
& amg_z_base_solver_type, psb_dpk_, amg_z_ainv_solver_type, psb_ipk_
|
||||
Implicit None
|
||||
class(amg_z_ainv_solver_type), intent(inout) :: sv
|
||||
class(amg_z_base_solver_type), intent(inout) :: svout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_z_ainv_solver_clone_settings
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
|
||||
@@ -159,44 +169,44 @@ module amg_z_ainv_solver
|
||||
end subroutine amg_z_ainv_solver_csetr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_ainv_solver_setc(sv,what,val,info)
|
||||
import :: amg_z_ainv_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_z_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_z_ainv_solver_setc
|
||||
end interface
|
||||
!!$ interface
|
||||
!!$ subroutine amg_z_ainv_solver_setc(sv,what,val,info)
|
||||
!!$ import :: amg_z_ainv_solver_type, psb_ipk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_z_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ character(len=*), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_z_ainv_solver_setc
|
||||
!!$ end interface
|
||||
!!$
|
||||
!!$ interface
|
||||
!!$ subroutine amg_z_ainv_solver_seti(sv,what,val,info)
|
||||
!!$ import :: amg_z_ainv_solver_type, psb_ipk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_z_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ integer(psb_ipk_), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_z_ainv_solver_seti
|
||||
!!$ end interface
|
||||
!!$
|
||||
!!$ interface
|
||||
!!$ subroutine amg_z_ainv_solver_setr(sv,what,val,info)
|
||||
!!$ import :: amg_z_ainv_solver_type, psb_ipk_, psb_dpk_
|
||||
!!$ Implicit none
|
||||
!!$ ! Arguments
|
||||
!!$ class(amg_z_ainv_solver_type), intent(inout) :: sv
|
||||
!!$ integer(psb_ipk_), intent(in) :: what
|
||||
!!$ real(psb_dpk_), intent(in) :: val
|
||||
!!$ integer(psb_ipk_), intent(out) :: info
|
||||
!!$ end subroutine amg_z_ainv_solver_setr
|
||||
!!$ end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_ainv_solver_seti(sv,what,val,info)
|
||||
import :: amg_z_ainv_solver_type, psb_ipk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_z_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_z_ainv_solver_seti
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_ainv_solver_setr(sv,what,val,info)
|
||||
import :: amg_z_ainv_solver_type, psb_ipk_, psb_dpk_
|
||||
Implicit none
|
||||
! Arguments
|
||||
class(amg_z_ainv_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine amg_z_ainv_solver_setr
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse)
|
||||
subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse,prefix)
|
||||
import :: psb_dpk_, amg_z_ainv_solver_type, psb_ipk_
|
||||
|
||||
Implicit None
|
||||
@@ -206,7 +216,7 @@ module amg_z_ainv_solver
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
end subroutine amg_z_ainv_solver_descr
|
||||
end interface
|
||||
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -396,21 +396,23 @@ contains
|
||||
end subroutine z_as_smoother_default
|
||||
|
||||
|
||||
subroutine z_as_smoother_descr(sm,info,iout,coarse)
|
||||
subroutine z_as_smoother_descr(sm,info,iout,coarse,prefix)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(amg_z_as_smoother_type), intent(in) :: sm
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in), optional :: iout
|
||||
logical, intent(in), optional :: coarse
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20), parameter :: name='amg_z_as_smoother_descr'
|
||||
integer(psb_ipk_) :: iout_
|
||||
logical :: coarse_
|
||||
character(1024) :: prefix_
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
@@ -424,16 +426,21 @@ contains
|
||||
else
|
||||
iout_ = psb_out_unit
|
||||
endif
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
if (.not.coarse_) then
|
||||
write(iout_,*) ' Additive Schwarz with ',&
|
||||
write(iout_,*) trim(prefix_), ' Additive Schwarz with ',&
|
||||
& sm%novr, ' overlap layers.'
|
||||
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) ' Local solver:'
|
||||
write(iout_,*) trim(prefix_), ' Restrictor: ',restrict_names(sm%restr)
|
||||
write(iout_,*) trim(prefix_), ' Prolongator: ',prolong_names(sm%prol)
|
||||
write(iout_,*) trim(prefix_), ' Local solver:'
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%descr(info,iout_,coarse=coarse)
|
||||
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -2,9 +2,9 @@
|
||||
!
|
||||
! AMG4PSBLAS version 1.0
|
||||
! Algebraic Multigrid Package
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
|
||||
! based on PSBLAS (Parallel Sparse BLAS version 3.7)
|
||||
!
|
||||
! (C) Copyright 2020
|
||||
! (C) Copyright 2021
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Pasqua D'Ambra
|
||||
@@ -126,7 +126,7 @@ module amg_z_base_aggregator_mod
|
||||
& psb_z_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
|
||||
implicit none
|
||||
type(psb_z_csr_sparse_mat), intent(inout) :: a_csr
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: nlaggr(:)
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_z_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
|
||||
@@ -144,7 +144,7 @@ module amg_z_base_aggregator_mod
|
||||
& psb_z_coo_sparse_mat, amg_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_
|
||||
implicit none
|
||||
type(psb_z_csr_sparse_mat), intent(inout) :: a_csr
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_desc_type), intent(inout) :: desc_a
|
||||
integer(psb_lpk_), intent(inout) :: nlaggr(:)
|
||||
type(amg_dml_parms), intent(inout) :: parms
|
||||
type(psb_z_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr
|
||||
@@ -275,15 +275,22 @@ contains
|
||||
val = .false.
|
||||
end function amg_z_base_aggregator_xt_desc
|
||||
|
||||
subroutine amg_z_base_aggregator_descr(ag,parms,iout,info)
|
||||
subroutine amg_z_base_aggregator_descr(ag,parms,iout,info,prefix)
|
||||
implicit none
|
||||
class(amg_z_base_aggregator_type), intent(in) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in), optional :: prefix
|
||||
character(1024) :: prefix_
|
||||
if (present(prefix)) then
|
||||
prefix_ = prefix
|
||||
else
|
||||
prefix_ = ""
|
||||
end if
|
||||
|
||||
write(iout,*) 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info)
|
||||
write(iout,*) trim(prefix_),' ', 'Aggregator object type: ',ag%fmt()
|
||||
call parms%mldescr(iout,info,prefix=prefix)
|
||||
|
||||
return
|
||||
end subroutine amg_z_base_aggregator_descr
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user