Compare commits
63 Commits
c9605d1b29
...
ecb41dfbbf
Author | SHA1 | Date |
---|---|---|
sfilippone | ecb41dfbbf | 3 months ago |
sfilippone | 33ac3f786b | 3 months ago |
sfilippone | 474c6a3634 | 3 months ago |
sfilippone | c1e8bc0c57 | 3 months ago |
sfilippone | 2f5072166d | 3 months ago |
sfilippone | 89e2d53e8b | 3 months ago |
sfilippone | bfe0a32e09 | 3 months ago |
sfilippone | e88d176fed | 3 months ago |
sfilippone | c96727a97c | 4 months ago |
sfilippone | 6362db0cc5 | 4 months ago |
sfilippone | 9239b16175 | 4 months ago |
sfilippone | 96a700cb9d | 4 months ago |
sfilippone | 41d91120d4 | 4 months ago |
sfilippone | 5d20407b15 | 4 months ago |
sfilippone | 322e3f65d1 | 4 months ago |
sfilippone | 3ff1ad9372 | 4 months ago |
sfilippone | 818ead5878 | 4 months ago |
sfilippone | 803d311d1c | 4 months ago |
sfilippone | 677e4fe6bc | 4 months ago |
sfilippone | 02a83575a2 | 4 months ago |
sfilippone | cfbec1f6ea | 4 months ago |
sfilippone | e11a134a1f | 5 months ago |
sfilippone | 6d05120930 | 5 months ago |
sfilippone | bd2d1e3b26 | 5 months ago |
sfilippone | 67594f8b07 | 5 months ago |
sfilippone | 301fb57bb1 | 5 months ago |
sfilippone | 13eee99ea3 | 5 months ago |
sfilippone | fb802c62cd | 5 months ago |
Salvatore Filippone | 897c5229a6 | 5 months ago |
Salvatore Filippone | ab5eaac5ed | 5 months ago |
sfilippone | 234071869d | 5 months ago |
sfilippone | 3e3b343131 | 5 months ago |
Cirdans-Home | 5790aa0cbd | 6 months ago |
Cirdans-Home | a17f503486 | 6 months ago |
Cirdans-Home | 74dccb6c44 | 6 months ago |
sfilippone | e83bde6896 | 6 months ago |
Salvatore Filippone | 83d435b49e | 7 months ago |
Salvatore Filippone | af3fda9690 | 7 months ago |
Salvatore Filippone | 678237cf29 | 7 months ago |
Salvatore Filippone | 3671285c7a | 7 months ago |
sfilippone | a747cc6abb | 7 months ago |
Cirdans-Home | d385d99e71 | 8 months ago |
Salvatore Filippone | 4e6e3d5f09 | 8 months ago |
Salvatore Filippone | 7c48b96936 | 8 months ago |
Salvatore Filippone | 12478a2fff | 8 months ago |
Cirdans-Home | ea8974f88c | 9 months ago |
Cirdans-Home | 54d608d2dd | 9 months ago |
sfilippone | 47bafd7fe7 | 11 months ago |
sfilippone | ccef858192 | 11 months ago |
sfilippone | 30a5c7be03 | 11 months ago |
sfilippone | 737ebb9a96 | 11 months ago |
sfilippone | dc15b931a0 | 11 months ago |
sfilippone | 23aabd794d | 11 months ago |
sfilippone | a67454ef5c | 11 months ago |
sfilippone | 79317cb392 | 11 months ago |
sfilippone | 847ed6ae60 | 11 months ago |
sfilippone | 6ad82037c5 | 11 months ago |
sfilippone | bee9d63e9c | 11 months ago |
sfilippone | bb262275a1 | 11 months ago |
sfilippone | 14cd4cde76 | 11 months ago |
sfilippone | ec9fcb1bcc | 11 months ago |
sfilippone | 2dd1cbd3dc | 11 months ago |
sfilippone | ea2f75776c | 11 months ago |
@ -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), allocatable, 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
|
@ -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), allocatable, 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
|
@ -0,0 +1,152 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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_dfile_prec_memory_use.f90
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! Subroutine: amg_file_prec_memory_use
|
||||||
|
! Version: complex
|
||||||
|
!
|
||||||
|
! This routine prints a memory_useiption of the preconditioner to the standard
|
||||||
|
! output or to a file. It must be called after the preconditioner has been
|
||||||
|
! built by amg_precbld.
|
||||||
|
!
|
||||||
|
! Arguments:
|
||||||
|
! p - type(amg_Tprec_type), input.
|
||||||
|
! The preconditioner data structure to be printed out.
|
||||||
|
! info - integer, output.
|
||||||
|
! error code.
|
||||||
|
! iout - integer, input, optional.
|
||||||
|
! The id of the file where the preconditioner description
|
||||||
|
! will be printed. If iout is not present, then the standard
|
||||||
|
! output is condidered.
|
||||||
|
! root - integer, input, optional.
|
||||||
|
! The id of the process printing the message; -1 acts as a wildcard.
|
||||||
|
! Default is psb_root_
|
||||||
|
!
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! verbosity:
|
||||||
|
! <0: suppress all messages
|
||||||
|
! 0: normal
|
||||||
|
! >1: increased details
|
||||||
|
!
|
||||||
|
subroutine amg_cfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,global)
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_c_prec_mod, amg_protect_name => amg_cfile_prec_memory_use
|
||||||
|
use amg_c_inner_mod
|
||||||
|
use amg_c_gs_solver
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
|
||||||
|
! Local variables
|
||||||
|
integer(psb_ipk_) :: ilev, nlev, ilmin, nswps
|
||||||
|
type(psb_ctxt_type) :: ctxt
|
||||||
|
integer(psb_ipk_) :: me, np
|
||||||
|
logical :: is_symgs
|
||||||
|
character(len=20), parameter :: name='amg_file_prec_memory_use'
|
||||||
|
integer(psb_ipk_) :: iout_, root_, verbosity_
|
||||||
|
logical :: global_
|
||||||
|
character(1024) :: prefix_
|
||||||
|
|
||||||
|
info = psb_success_
|
||||||
|
if (present(iout)) then
|
||||||
|
iout_ = iout
|
||||||
|
else
|
||||||
|
iout_ = psb_out_unit
|
||||||
|
end if
|
||||||
|
if (iout_ < 0) iout_ = psb_out_unit
|
||||||
|
if (present(verbosity)) then
|
||||||
|
verbosity_ = verbosity
|
||||||
|
else
|
||||||
|
verbosity_ = 0
|
||||||
|
end if
|
||||||
|
if (verbosity_ < 0) goto 9998
|
||||||
|
|
||||||
|
ctxt = prec%ctxt
|
||||||
|
call psb_info(ctxt,me,np)
|
||||||
|
prefix_ = ""
|
||||||
|
if (verbosity_ == 0) then
|
||||||
|
if (present(prefix)) then
|
||||||
|
prefix_ = prefix
|
||||||
|
end if
|
||||||
|
else if (verbosity_ > 0) then
|
||||||
|
if (present(prefix)) then
|
||||||
|
write(prefix_,'(a,a,i5,a)') prefix,' from process ',me,': '
|
||||||
|
else
|
||||||
|
write(prefix_,'(a,i5,a)') 'Process ',me,': '
|
||||||
|
end if
|
||||||
|
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (present(root)) then
|
||||||
|
root_ = root
|
||||||
|
else
|
||||||
|
root_ = psb_root_
|
||||||
|
end if
|
||||||
|
if (root_ == -1) root_ = me
|
||||||
|
|
||||||
|
if (allocated(prec%precv)) then
|
||||||
|
if (verbosity_ >=0) then
|
||||||
|
if (me == root_) then
|
||||||
|
write(iout_,*)
|
||||||
|
write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage'
|
||||||
|
end if
|
||||||
|
nlev = size(prec%precv)
|
||||||
|
do ilev=1,nlev
|
||||||
|
call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, &
|
||||||
|
& iout=iout_,verbosity=verbosity_,prefix=trim(prefix_),global=global)
|
||||||
|
end do
|
||||||
|
|
||||||
|
else
|
||||||
|
write(iout_,*) trim(name), &
|
||||||
|
& ': Error: no base preconditioner available, something is wrong!'
|
||||||
|
info = -2
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
end if
|
||||||
|
9998 continue
|
||||||
|
end subroutine amg_cfile_prec_memory_use
|
@ -0,0 +1,152 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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_dfile_prec_memory_use.f90
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! Subroutine: amg_file_prec_memory_use
|
||||||
|
! Version: real
|
||||||
|
!
|
||||||
|
! This routine prints a memory_useiption of the preconditioner to the standard
|
||||||
|
! output or to a file. It must be called after the preconditioner has been
|
||||||
|
! built by amg_precbld.
|
||||||
|
!
|
||||||
|
! Arguments:
|
||||||
|
! p - type(amg_Tprec_type), input.
|
||||||
|
! The preconditioner data structure to be printed out.
|
||||||
|
! info - integer, output.
|
||||||
|
! error code.
|
||||||
|
! iout - integer, input, optional.
|
||||||
|
! The id of the file where the preconditioner description
|
||||||
|
! will be printed. If iout is not present, then the standard
|
||||||
|
! output is condidered.
|
||||||
|
! root - integer, input, optional.
|
||||||
|
! The id of the process printing the message; -1 acts as a wildcard.
|
||||||
|
! Default is psb_root_
|
||||||
|
!
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! verbosity:
|
||||||
|
! <0: suppress all messages
|
||||||
|
! 0: normal
|
||||||
|
! >1: increased details
|
||||||
|
!
|
||||||
|
subroutine amg_dfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,global)
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_d_prec_mod, amg_protect_name => amg_dfile_prec_memory_use
|
||||||
|
use amg_d_inner_mod
|
||||||
|
use amg_d_gs_solver
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
|
||||||
|
! Local variables
|
||||||
|
integer(psb_ipk_) :: ilev, nlev, ilmin, nswps
|
||||||
|
type(psb_ctxt_type) :: ctxt
|
||||||
|
integer(psb_ipk_) :: me, np
|
||||||
|
logical :: is_symgs
|
||||||
|
character(len=20), parameter :: name='amg_file_prec_memory_use'
|
||||||
|
integer(psb_ipk_) :: iout_, root_, verbosity_
|
||||||
|
logical :: global_
|
||||||
|
character(1024) :: prefix_
|
||||||
|
|
||||||
|
info = psb_success_
|
||||||
|
if (present(iout)) then
|
||||||
|
iout_ = iout
|
||||||
|
else
|
||||||
|
iout_ = psb_out_unit
|
||||||
|
end if
|
||||||
|
if (iout_ < 0) iout_ = psb_out_unit
|
||||||
|
if (present(verbosity)) then
|
||||||
|
verbosity_ = verbosity
|
||||||
|
else
|
||||||
|
verbosity_ = 0
|
||||||
|
end if
|
||||||
|
if (verbosity_ < 0) goto 9998
|
||||||
|
|
||||||
|
ctxt = prec%ctxt
|
||||||
|
call psb_info(ctxt,me,np)
|
||||||
|
prefix_ = ""
|
||||||
|
if (verbosity_ == 0) then
|
||||||
|
if (present(prefix)) then
|
||||||
|
prefix_ = prefix
|
||||||
|
end if
|
||||||
|
else if (verbosity_ > 0) then
|
||||||
|
if (present(prefix)) then
|
||||||
|
write(prefix_,'(a,a,i5,a)') prefix,' from process ',me,': '
|
||||||
|
else
|
||||||
|
write(prefix_,'(a,i5,a)') 'Process ',me,': '
|
||||||
|
end if
|
||||||
|
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (present(root)) then
|
||||||
|
root_ = root
|
||||||
|
else
|
||||||
|
root_ = psb_root_
|
||||||
|
end if
|
||||||
|
if (root_ == -1) root_ = me
|
||||||
|
|
||||||
|
if (allocated(prec%precv)) then
|
||||||
|
if (verbosity_ >=0) then
|
||||||
|
if (me == root_) then
|
||||||
|
write(iout_,*)
|
||||||
|
write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage'
|
||||||
|
end if
|
||||||
|
nlev = size(prec%precv)
|
||||||
|
do ilev=1,nlev
|
||||||
|
call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, &
|
||||||
|
& iout=iout_,verbosity=verbosity_,prefix=trim(prefix_),global=global)
|
||||||
|
end do
|
||||||
|
|
||||||
|
else
|
||||||
|
write(iout_,*) trim(name), &
|
||||||
|
& ': Error: no base preconditioner available, something is wrong!'
|
||||||
|
info = -2
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
end if
|
||||||
|
9998 continue
|
||||||
|
end subroutine amg_dfile_prec_memory_use
|
@ -0,0 +1,152 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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_dfile_prec_memory_use.f90
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! Subroutine: amg_file_prec_memory_use
|
||||||
|
! Version: real
|
||||||
|
!
|
||||||
|
! This routine prints a memory_useiption of the preconditioner to the standard
|
||||||
|
! output or to a file. It must be called after the preconditioner has been
|
||||||
|
! built by amg_precbld.
|
||||||
|
!
|
||||||
|
! Arguments:
|
||||||
|
! p - type(amg_Tprec_type), input.
|
||||||
|
! The preconditioner data structure to be printed out.
|
||||||
|
! info - integer, output.
|
||||||
|
! error code.
|
||||||
|
! iout - integer, input, optional.
|
||||||
|
! The id of the file where the preconditioner description
|
||||||
|
! will be printed. If iout is not present, then the standard
|
||||||
|
! output is condidered.
|
||||||
|
! root - integer, input, optional.
|
||||||
|
! The id of the process printing the message; -1 acts as a wildcard.
|
||||||
|
! Default is psb_root_
|
||||||
|
!
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! verbosity:
|
||||||
|
! <0: suppress all messages
|
||||||
|
! 0: normal
|
||||||
|
! >1: increased details
|
||||||
|
!
|
||||||
|
subroutine amg_sfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,global)
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_s_prec_mod, amg_protect_name => amg_sfile_prec_memory_use
|
||||||
|
use amg_s_inner_mod
|
||||||
|
use amg_s_gs_solver
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
|
||||||
|
! Local variables
|
||||||
|
integer(psb_ipk_) :: ilev, nlev, ilmin, nswps
|
||||||
|
type(psb_ctxt_type) :: ctxt
|
||||||
|
integer(psb_ipk_) :: me, np
|
||||||
|
logical :: is_symgs
|
||||||
|
character(len=20), parameter :: name='amg_file_prec_memory_use'
|
||||||
|
integer(psb_ipk_) :: iout_, root_, verbosity_
|
||||||
|
logical :: global_
|
||||||
|
character(1024) :: prefix_
|
||||||
|
|
||||||
|
info = psb_success_
|
||||||
|
if (present(iout)) then
|
||||||
|
iout_ = iout
|
||||||
|
else
|
||||||
|
iout_ = psb_out_unit
|
||||||
|
end if
|
||||||
|
if (iout_ < 0) iout_ = psb_out_unit
|
||||||
|
if (present(verbosity)) then
|
||||||
|
verbosity_ = verbosity
|
||||||
|
else
|
||||||
|
verbosity_ = 0
|
||||||
|
end if
|
||||||
|
if (verbosity_ < 0) goto 9998
|
||||||
|
|
||||||
|
ctxt = prec%ctxt
|
||||||
|
call psb_info(ctxt,me,np)
|
||||||
|
prefix_ = ""
|
||||||
|
if (verbosity_ == 0) then
|
||||||
|
if (present(prefix)) then
|
||||||
|
prefix_ = prefix
|
||||||
|
end if
|
||||||
|
else if (verbosity_ > 0) then
|
||||||
|
if (present(prefix)) then
|
||||||
|
write(prefix_,'(a,a,i5,a)') prefix,' from process ',me,': '
|
||||||
|
else
|
||||||
|
write(prefix_,'(a,i5,a)') 'Process ',me,': '
|
||||||
|
end if
|
||||||
|
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (present(root)) then
|
||||||
|
root_ = root
|
||||||
|
else
|
||||||
|
root_ = psb_root_
|
||||||
|
end if
|
||||||
|
if (root_ == -1) root_ = me
|
||||||
|
|
||||||
|
if (allocated(prec%precv)) then
|
||||||
|
if (verbosity_ >=0) then
|
||||||
|
if (me == root_) then
|
||||||
|
write(iout_,*)
|
||||||
|
write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage'
|
||||||
|
end if
|
||||||
|
nlev = size(prec%precv)
|
||||||
|
do ilev=1,nlev
|
||||||
|
call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, &
|
||||||
|
& iout=iout_,verbosity=verbosity_,prefix=trim(prefix_),global=global)
|
||||||
|
end do
|
||||||
|
|
||||||
|
else
|
||||||
|
write(iout_,*) trim(name), &
|
||||||
|
& ': Error: no base preconditioner available, something is wrong!'
|
||||||
|
info = -2
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
end if
|
||||||
|
9998 continue
|
||||||
|
end subroutine amg_sfile_prec_memory_use
|
@ -0,0 +1,152 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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_dfile_prec_memory_use.f90
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! Subroutine: amg_file_prec_memory_use
|
||||||
|
! Version: complex
|
||||||
|
!
|
||||||
|
! This routine prints a memory_useiption of the preconditioner to the standard
|
||||||
|
! output or to a file. It must be called after the preconditioner has been
|
||||||
|
! built by amg_precbld.
|
||||||
|
!
|
||||||
|
! Arguments:
|
||||||
|
! p - type(amg_Tprec_type), input.
|
||||||
|
! The preconditioner data structure to be printed out.
|
||||||
|
! info - integer, output.
|
||||||
|
! error code.
|
||||||
|
! iout - integer, input, optional.
|
||||||
|
! The id of the file where the preconditioner description
|
||||||
|
! will be printed. If iout is not present, then the standard
|
||||||
|
! output is condidered.
|
||||||
|
! root - integer, input, optional.
|
||||||
|
! The id of the process printing the message; -1 acts as a wildcard.
|
||||||
|
! Default is psb_root_
|
||||||
|
!
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! verbosity:
|
||||||
|
! <0: suppress all messages
|
||||||
|
! 0: normal
|
||||||
|
! >1: increased details
|
||||||
|
!
|
||||||
|
subroutine amg_zfile_prec_memory_use(prec,info,iout,root, verbosity,prefix,global)
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_z_prec_mod, amg_protect_name => amg_zfile_prec_memory_use
|
||||||
|
use amg_z_inner_mod
|
||||||
|
use amg_z_gs_solver
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
! Arguments
|
||||||
|
class(amg_zprec_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
|
||||||
|
|
||||||
|
|
||||||
|
! Local variables
|
||||||
|
integer(psb_ipk_) :: ilev, nlev, ilmin, nswps
|
||||||
|
type(psb_ctxt_type) :: ctxt
|
||||||
|
integer(psb_ipk_) :: me, np
|
||||||
|
logical :: is_symgs
|
||||||
|
character(len=20), parameter :: name='amg_file_prec_memory_use'
|
||||||
|
integer(psb_ipk_) :: iout_, root_, verbosity_
|
||||||
|
logical :: global_
|
||||||
|
character(1024) :: prefix_
|
||||||
|
|
||||||
|
info = psb_success_
|
||||||
|
if (present(iout)) then
|
||||||
|
iout_ = iout
|
||||||
|
else
|
||||||
|
iout_ = psb_out_unit
|
||||||
|
end if
|
||||||
|
if (iout_ < 0) iout_ = psb_out_unit
|
||||||
|
if (present(verbosity)) then
|
||||||
|
verbosity_ = verbosity
|
||||||
|
else
|
||||||
|
verbosity_ = 0
|
||||||
|
end if
|
||||||
|
if (verbosity_ < 0) goto 9998
|
||||||
|
|
||||||
|
ctxt = prec%ctxt
|
||||||
|
call psb_info(ctxt,me,np)
|
||||||
|
prefix_ = ""
|
||||||
|
if (verbosity_ == 0) then
|
||||||
|
if (present(prefix)) then
|
||||||
|
prefix_ = prefix
|
||||||
|
end if
|
||||||
|
else if (verbosity_ > 0) then
|
||||||
|
if (present(prefix)) then
|
||||||
|
write(prefix_,'(a,a,i5,a)') prefix,' from process ',me,': '
|
||||||
|
else
|
||||||
|
write(prefix_,'(a,i5,a)') 'Process ',me,': '
|
||||||
|
end if
|
||||||
|
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (present(root)) then
|
||||||
|
root_ = root
|
||||||
|
else
|
||||||
|
root_ = psb_root_
|
||||||
|
end if
|
||||||
|
if (root_ == -1) root_ = me
|
||||||
|
|
||||||
|
if (allocated(prec%precv)) then
|
||||||
|
if (verbosity_ >=0) then
|
||||||
|
if (me == root_) then
|
||||||
|
write(iout_,*)
|
||||||
|
write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner memory usage'
|
||||||
|
end if
|
||||||
|
nlev = size(prec%precv)
|
||||||
|
do ilev=1,nlev
|
||||||
|
call prec%precv(ilev)%memory_use(ilev,nlev,ilmin,info, &
|
||||||
|
& iout=iout_,verbosity=verbosity_,prefix=trim(prefix_),global=global)
|
||||||
|
end do
|
||||||
|
|
||||||
|
else
|
||||||
|
write(iout_,*) trim(name), &
|
||||||
|
& ': Error: no base preconditioner available, something is wrong!'
|
||||||
|
info = -2
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
end if
|
||||||
|
9998 continue
|
||||||
|
end subroutine amg_zfile_prec_memory_use
|
@ -0,0 +1,150 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! verbosity:
|
||||||
|
! <0: suppress all messages
|
||||||
|
! 0: normal
|
||||||
|
! >1: increased details
|
||||||
|
!
|
||||||
|
subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefix,global)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_c_onelev_mod, amg_protect_name => amg_c_base_onelev_memory_use
|
||||||
|
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
|
||||||
|
character(len=*), intent(in), optional :: prefix
|
||||||
|
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||||
|
logical, intent(in), optional :: global
|
||||||
|
|
||||||
|
|
||||||
|
! Local variables
|
||||||
|
type(psb_ctxt_type) :: ctxt
|
||||||
|
integer(psb_ipk_) :: err_act ,me, np
|
||||||
|
character(len=20), parameter :: name='amg_c_base_onelev_memory_use'
|
||||||
|
integer(psb_ipk_) :: iout_, verbosity_
|
||||||
|
logical :: coarse, global_
|
||||||
|
character(1024) :: prefix_
|
||||||
|
integer(psb_epk_), allocatable :: sz(:)
|
||||||
|
|
||||||
|
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
|
||||||
|
ctxt = lv%base_desc%get_ctxt()
|
||||||
|
call psb_info(ctxt,me,np)
|
||||||
|
|
||||||
|
coarse = (il==nl)
|
||||||
|
|
||||||
|
if (present(iout)) then
|
||||||
|
iout_ = iout
|
||||||
|
else
|
||||||
|
iout_ = psb_out_unit
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (present(verbosity)) then
|
||||||
|
verbosity_ = verbosity
|
||||||
|
else
|
||||||
|
verbosity_ = 0
|
||||||
|
end if
|
||||||
|
if (verbosity_ < 0) goto 9998
|
||||||
|
if (present(global)) then
|
||||||
|
global_ = global
|
||||||
|
else
|
||||||
|
global_ = .true.
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (present(prefix)) then
|
||||||
|
prefix_ = prefix
|
||||||
|
else
|
||||||
|
prefix_ = ""
|
||||||
|
end if
|
||||||
|
|
||||||
|
if ((me == 0).or.(verbosity_>0)) write(iout_,*) trim(prefix_)
|
||||||
|
|
||||||
|
if (global_) then
|
||||||
|
allocate(sz(6))
|
||||||
|
sz(:) = 0
|
||||||
|
sz(1) = lv%base_a%sizeof()
|
||||||
|
sz(2) = lv%base_desc%sizeof()
|
||||||
|
if (il >1) sz(3) = lv%linmap%sizeof()
|
||||||
|
if (allocated(lv%sm)) sz(4) = lv%sm%sizeof()
|
||||||
|
if (allocated(lv%sm2a)) sz(5) = lv%sm2a%sizeof()
|
||||||
|
if (allocated(lv%wrk)) sz(6) = lv%wrk%sizeof()
|
||||||
|
call psb_sum(ctxt,sz)
|
||||||
|
if (me == 0) then
|
||||||
|
if (coarse) then
|
||||||
|
write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)'
|
||||||
|
else
|
||||||
|
write(iout_,*) trim(prefix_), ' Level ',il
|
||||||
|
end if
|
||||||
|
write(iout_,*) trim(prefix_), ' Matrix:', sz(1)
|
||||||
|
write(iout_,*) trim(prefix_), ' Descriptor:', sz(2)
|
||||||
|
if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', sz(3)
|
||||||
|
if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', sz(4)
|
||||||
|
if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', sz(5)
|
||||||
|
if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', sz(6)
|
||||||
|
end if
|
||||||
|
|
||||||
|
else
|
||||||
|
if ((me == 0).or.(verbosity_>0)) then
|
||||||
|
if (coarse) then
|
||||||
|
write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)'
|
||||||
|
else
|
||||||
|
write(iout_,*) trim(prefix_), ' Level ',il
|
||||||
|
end if
|
||||||
|
write(iout_,*) trim(prefix_), ' Matrix:', lv%base_a%sizeof()
|
||||||
|
write(iout_,*) trim(prefix_), ' Descriptor:', lv%base_desc%sizeof()
|
||||||
|
if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', lv%linmap%sizeof()
|
||||||
|
if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', lv%sm%sizeof()
|
||||||
|
if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', lv%sm2a%sizeof()
|
||||||
|
if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', lv%wrk%sizeof()
|
||||||
|
end if
|
||||||
|
endif
|
||||||
|
|
||||||
|
9998 continue
|
||||||
|
call psb_erractionrestore(err_act)
|
||||||
|
return
|
||||||
|
|
||||||
|
9999 call psb_error_handler(err_act)
|
||||||
|
return
|
||||||
|
|
||||||
|
end subroutine amg_c_base_onelev_memory_use
|
@ -0,0 +1,150 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! verbosity:
|
||||||
|
! <0: suppress all messages
|
||||||
|
! 0: normal
|
||||||
|
! >1: increased details
|
||||||
|
!
|
||||||
|
subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefix,global)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_d_onelev_mod, amg_protect_name => amg_d_base_onelev_memory_use
|
||||||
|
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
|
||||||
|
character(len=*), intent(in), optional :: prefix
|
||||||
|
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||||
|
logical, intent(in), optional :: global
|
||||||
|
|
||||||
|
|
||||||
|
! Local variables
|
||||||
|
type(psb_ctxt_type) :: ctxt
|
||||||
|
integer(psb_ipk_) :: err_act ,me, np
|
||||||
|
character(len=20), parameter :: name='amg_d_base_onelev_memory_use'
|
||||||
|
integer(psb_ipk_) :: iout_, verbosity_
|
||||||
|
logical :: coarse, global_
|
||||||
|
character(1024) :: prefix_
|
||||||
|
integer(psb_epk_), allocatable :: sz(:)
|
||||||
|
|
||||||
|
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
|
||||||
|
ctxt = lv%base_desc%get_ctxt()
|
||||||
|
call psb_info(ctxt,me,np)
|
||||||
|
|
||||||
|
coarse = (il==nl)
|
||||||
|
|
||||||
|
if (present(iout)) then
|
||||||
|
iout_ = iout
|
||||||
|
else
|
||||||
|
iout_ = psb_out_unit
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (present(verbosity)) then
|
||||||
|
verbosity_ = verbosity
|
||||||
|
else
|
||||||
|
verbosity_ = 0
|
||||||
|
end if
|
||||||
|
if (verbosity_ < 0) goto 9998
|
||||||
|
if (present(global)) then
|
||||||
|
global_ = global
|
||||||
|
else
|
||||||
|
global_ = .true.
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (present(prefix)) then
|
||||||
|
prefix_ = prefix
|
||||||
|
else
|
||||||
|
prefix_ = ""
|
||||||
|
end if
|
||||||
|
|
||||||
|
if ((me == 0).or.(verbosity_>0)) write(iout_,*) trim(prefix_)
|
||||||
|
|
||||||
|
if (global_) then
|
||||||
|
allocate(sz(6))
|
||||||
|
sz(:) = 0
|
||||||
|
sz(1) = lv%base_a%sizeof()
|
||||||
|
sz(2) = lv%base_desc%sizeof()
|
||||||
|
if (il >1) sz(3) = lv%linmap%sizeof()
|
||||||
|
if (allocated(lv%sm)) sz(4) = lv%sm%sizeof()
|
||||||
|
if (allocated(lv%sm2a)) sz(5) = lv%sm2a%sizeof()
|
||||||
|
if (allocated(lv%wrk)) sz(6) = lv%wrk%sizeof()
|
||||||
|
call psb_sum(ctxt,sz)
|
||||||
|
if (me == 0) then
|
||||||
|
if (coarse) then
|
||||||
|
write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)'
|
||||||
|
else
|
||||||
|
write(iout_,*) trim(prefix_), ' Level ',il
|
||||||
|
end if
|
||||||
|
write(iout_,*) trim(prefix_), ' Matrix:', sz(1)
|
||||||
|
write(iout_,*) trim(prefix_), ' Descriptor:', sz(2)
|
||||||
|
if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', sz(3)
|
||||||
|
if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', sz(4)
|
||||||
|
if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', sz(5)
|
||||||
|
if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', sz(6)
|
||||||
|
end if
|
||||||
|
|
||||||
|
else
|
||||||
|
if ((me == 0).or.(verbosity_>0)) then
|
||||||
|
if (coarse) then
|
||||||
|
write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)'
|
||||||
|
else
|
||||||
|
write(iout_,*) trim(prefix_), ' Level ',il
|
||||||
|
end if
|
||||||
|
write(iout_,*) trim(prefix_), ' Matrix:', lv%base_a%sizeof()
|
||||||
|
write(iout_,*) trim(prefix_), ' Descriptor:', lv%base_desc%sizeof()
|
||||||
|
if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', lv%linmap%sizeof()
|
||||||
|
if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', lv%sm%sizeof()
|
||||||
|
if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', lv%sm2a%sizeof()
|
||||||
|
if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', lv%wrk%sizeof()
|
||||||
|
end if
|
||||||
|
endif
|
||||||
|
|
||||||
|
9998 continue
|
||||||
|
call psb_erractionrestore(err_act)
|
||||||
|
return
|
||||||
|
|
||||||
|
9999 call psb_error_handler(err_act)
|
||||||
|
return
|
||||||
|
|
||||||
|
end subroutine amg_d_base_onelev_memory_use
|
@ -0,0 +1,150 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! verbosity:
|
||||||
|
! <0: suppress all messages
|
||||||
|
! 0: normal
|
||||||
|
! >1: increased details
|
||||||
|
!
|
||||||
|
subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefix,global)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_s_onelev_mod, amg_protect_name => amg_s_base_onelev_memory_use
|
||||||
|
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
|
||||||
|
character(len=*), intent(in), optional :: prefix
|
||||||
|
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||||
|
logical, intent(in), optional :: global
|
||||||
|
|
||||||
|
|
||||||
|
! Local variables
|
||||||
|
type(psb_ctxt_type) :: ctxt
|
||||||
|
integer(psb_ipk_) :: err_act ,me, np
|
||||||
|
character(len=20), parameter :: name='amg_s_base_onelev_memory_use'
|
||||||
|
integer(psb_ipk_) :: iout_, verbosity_
|
||||||
|
logical :: coarse, global_
|
||||||
|
character(1024) :: prefix_
|
||||||
|
integer(psb_epk_), allocatable :: sz(:)
|
||||||
|
|
||||||
|
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
|
||||||
|
ctxt = lv%base_desc%get_ctxt()
|
||||||
|
call psb_info(ctxt,me,np)
|
||||||
|
|
||||||
|
coarse = (il==nl)
|
||||||
|
|
||||||
|
if (present(iout)) then
|
||||||
|
iout_ = iout
|
||||||
|
else
|
||||||
|
iout_ = psb_out_unit
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (present(verbosity)) then
|
||||||
|
verbosity_ = verbosity
|
||||||
|
else
|
||||||
|
verbosity_ = 0
|
||||||
|
end if
|
||||||
|
if (verbosity_ < 0) goto 9998
|
||||||
|
if (present(global)) then
|
||||||
|
global_ = global
|
||||||
|
else
|
||||||
|
global_ = .true.
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (present(prefix)) then
|
||||||
|
prefix_ = prefix
|
||||||
|
else
|
||||||
|
prefix_ = ""
|
||||||
|
end if
|
||||||
|
|
||||||
|
if ((me == 0).or.(verbosity_>0)) write(iout_,*) trim(prefix_)
|
||||||
|
|
||||||
|
if (global_) then
|
||||||
|
allocate(sz(6))
|
||||||
|
sz(:) = 0
|
||||||
|
sz(1) = lv%base_a%sizeof()
|
||||||
|
sz(2) = lv%base_desc%sizeof()
|
||||||
|
if (il >1) sz(3) = lv%linmap%sizeof()
|
||||||
|
if (allocated(lv%sm)) sz(4) = lv%sm%sizeof()
|
||||||
|
if (allocated(lv%sm2a)) sz(5) = lv%sm2a%sizeof()
|
||||||
|
if (allocated(lv%wrk)) sz(6) = lv%wrk%sizeof()
|
||||||
|
call psb_sum(ctxt,sz)
|
||||||
|
if (me == 0) then
|
||||||
|
if (coarse) then
|
||||||
|
write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)'
|
||||||
|
else
|
||||||
|
write(iout_,*) trim(prefix_), ' Level ',il
|
||||||
|
end if
|
||||||
|
write(iout_,*) trim(prefix_), ' Matrix:', sz(1)
|
||||||
|
write(iout_,*) trim(prefix_), ' Descriptor:', sz(2)
|
||||||
|
if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', sz(3)
|
||||||
|
if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', sz(4)
|
||||||
|
if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', sz(5)
|
||||||
|
if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', sz(6)
|
||||||
|
end if
|
||||||
|
|
||||||
|
else
|
||||||
|
if ((me == 0).or.(verbosity_>0)) then
|
||||||
|
if (coarse) then
|
||||||
|
write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)'
|
||||||
|
else
|
||||||
|
write(iout_,*) trim(prefix_), ' Level ',il
|
||||||
|
end if
|
||||||
|
write(iout_,*) trim(prefix_), ' Matrix:', lv%base_a%sizeof()
|
||||||
|
write(iout_,*) trim(prefix_), ' Descriptor:', lv%base_desc%sizeof()
|
||||||
|
if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', lv%linmap%sizeof()
|
||||||
|
if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', lv%sm%sizeof()
|
||||||
|
if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', lv%sm2a%sizeof()
|
||||||
|
if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', lv%wrk%sizeof()
|
||||||
|
end if
|
||||||
|
endif
|
||||||
|
|
||||||
|
9998 continue
|
||||||
|
call psb_erractionrestore(err_act)
|
||||||
|
return
|
||||||
|
|
||||||
|
9999 call psb_error_handler(err_act)
|
||||||
|
return
|
||||||
|
|
||||||
|
end subroutine amg_s_base_onelev_memory_use
|
@ -0,0 +1,150 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! verbosity:
|
||||||
|
! <0: suppress all messages
|
||||||
|
! 0: normal
|
||||||
|
! >1: increased details
|
||||||
|
!
|
||||||
|
subroutine amg_z_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity,prefix,global)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_z_onelev_mod, amg_protect_name => amg_z_base_onelev_memory_use
|
||||||
|
Implicit None
|
||||||
|
! Arguments
|
||||||
|
class(amg_z_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
|
||||||
|
character(len=*), intent(in), optional :: prefix
|
||||||
|
integer(psb_ipk_), intent(in), optional :: verbosity
|
||||||
|
logical, intent(in), optional :: global
|
||||||
|
|
||||||
|
|
||||||
|
! Local variables
|
||||||
|
type(psb_ctxt_type) :: ctxt
|
||||||
|
integer(psb_ipk_) :: err_act ,me, np
|
||||||
|
character(len=20), parameter :: name='amg_z_base_onelev_memory_use'
|
||||||
|
integer(psb_ipk_) :: iout_, verbosity_
|
||||||
|
logical :: coarse, global_
|
||||||
|
character(1024) :: prefix_
|
||||||
|
integer(psb_epk_), allocatable :: sz(:)
|
||||||
|
|
||||||
|
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
|
||||||
|
ctxt = lv%base_desc%get_ctxt()
|
||||||
|
call psb_info(ctxt,me,np)
|
||||||
|
|
||||||
|
coarse = (il==nl)
|
||||||
|
|
||||||
|
if (present(iout)) then
|
||||||
|
iout_ = iout
|
||||||
|
else
|
||||||
|
iout_ = psb_out_unit
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (present(verbosity)) then
|
||||||
|
verbosity_ = verbosity
|
||||||
|
else
|
||||||
|
verbosity_ = 0
|
||||||
|
end if
|
||||||
|
if (verbosity_ < 0) goto 9998
|
||||||
|
if (present(global)) then
|
||||||
|
global_ = global
|
||||||
|
else
|
||||||
|
global_ = .true.
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (present(prefix)) then
|
||||||
|
prefix_ = prefix
|
||||||
|
else
|
||||||
|
prefix_ = ""
|
||||||
|
end if
|
||||||
|
|
||||||
|
if ((me == 0).or.(verbosity_>0)) write(iout_,*) trim(prefix_)
|
||||||
|
|
||||||
|
if (global_) then
|
||||||
|
allocate(sz(6))
|
||||||
|
sz(:) = 0
|
||||||
|
sz(1) = lv%base_a%sizeof()
|
||||||
|
sz(2) = lv%base_desc%sizeof()
|
||||||
|
if (il >1) sz(3) = lv%linmap%sizeof()
|
||||||
|
if (allocated(lv%sm)) sz(4) = lv%sm%sizeof()
|
||||||
|
if (allocated(lv%sm2a)) sz(5) = lv%sm2a%sizeof()
|
||||||
|
if (allocated(lv%wrk)) sz(6) = lv%wrk%sizeof()
|
||||||
|
call psb_sum(ctxt,sz)
|
||||||
|
if (me == 0) then
|
||||||
|
if (coarse) then
|
||||||
|
write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)'
|
||||||
|
else
|
||||||
|
write(iout_,*) trim(prefix_), ' Level ',il
|
||||||
|
end if
|
||||||
|
write(iout_,*) trim(prefix_), ' Matrix:', sz(1)
|
||||||
|
write(iout_,*) trim(prefix_), ' Descriptor:', sz(2)
|
||||||
|
if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', sz(3)
|
||||||
|
if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', sz(4)
|
||||||
|
if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', sz(5)
|
||||||
|
if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', sz(6)
|
||||||
|
end if
|
||||||
|
|
||||||
|
else
|
||||||
|
if ((me == 0).or.(verbosity_>0)) then
|
||||||
|
if (coarse) then
|
||||||
|
write(iout_,*) trim(prefix_), ' Level ',il,' (coarse)'
|
||||||
|
else
|
||||||
|
write(iout_,*) trim(prefix_), ' Level ',il
|
||||||
|
end if
|
||||||
|
write(iout_,*) trim(prefix_), ' Matrix:', lv%base_a%sizeof()
|
||||||
|
write(iout_,*) trim(prefix_), ' Descriptor:', lv%base_desc%sizeof()
|
||||||
|
if (il >1) write(iout_,*) trim(prefix_), ' Linear map:', lv%linmap%sizeof()
|
||||||
|
if (allocated(lv%sm)) write(iout_,*) trim(prefix_), ' Smoother:', lv%sm%sizeof()
|
||||||
|
if (allocated(lv%sm2a)) write(iout_,*) trim(prefix_), ' Smoother 2:', lv%sm2a%sizeof()
|
||||||
|
if (allocated(lv%wrk)) write(iout_,*) trim(prefix_), ' Workspace:', lv%wrk%sizeof()
|
||||||
|
end if
|
||||||
|
endif
|
||||||
|
|
||||||
|
9998 continue
|
||||||
|
call psb_erractionrestore(err_act)
|
||||||
|
return
|
||||||
|
|
||||||
|
9999 call psb_error_handler(err_act)
|
||||||
|
return
|
||||||
|
|
||||||
|
end subroutine amg_z_base_onelev_memory_use
|
@ -0,0 +1,281 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
subroutine amg_d_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||||
|
& sweeps,work,wv,info,init,initu)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_d_diag_solver
|
||||||
|
use psb_base_krylov_conv_mod, only : log_conv
|
||||||
|
use amg_d_poly_smoother, amg_protect_name => amg_d_poly_smoother_apply_vect
|
||||||
|
implicit none
|
||||||
|
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! this is ignored here, the polynomial degree dictates the value
|
||||||
|
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
|
||||||
|
! Timers
|
||||||
|
logical, parameter :: do_timings=.true.
|
||||||
|
integer(psb_ipk_), save :: poly_1=-1, poly_2=-1, poly_3=-1
|
||||||
|
integer(psb_ipk_), save :: poly_mv=-1, poly_sv=-1, poly_vect=-1
|
||||||
|
!
|
||||||
|
integer(psb_ipk_) :: n_row,n_col
|
||||||
|
type(psb_d_vect_type) :: tx, ty, tz, r
|
||||||
|
real(psb_dpk_), pointer :: aux(:)
|
||||||
|
type(psb_ctxt_type) :: ctxt
|
||||||
|
integer(psb_ipk_) :: np, me, i, err_act
|
||||||
|
character :: trans_, init_
|
||||||
|
real(psb_dpk_) :: res, resdenum
|
||||||
|
character(len=20) :: name='d_poly_smoother_apply_v'
|
||||||
|
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
|
||||||
|
info = psb_success_
|
||||||
|
ctxt = desc_data%get_context()
|
||||||
|
call psb_info(ctxt,me,np)
|
||||||
|
|
||||||
|
|
||||||
|
if (present(init)) then
|
||||||
|
init_ = psb_toupper(init)
|
||||||
|
else
|
||||||
|
init_='Z'
|
||||||
|
end if
|
||||||
|
|
||||||
|
trans_ = psb_toupper(trans)
|
||||||
|
select case(trans_)
|
||||||
|
case('N')
|
||||||
|
case('T','C')
|
||||||
|
case default
|
||||||
|
call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||||
|
goto 9999
|
||||||
|
end select
|
||||||
|
|
||||||
|
if (.not.allocated(sm%sv)) then
|
||||||
|
info = 1121
|
||||||
|
call psb_errpush(info,name)
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
|
||||||
|
if ((do_timings).and.(poly_1==-1)) &
|
||||||
|
& poly_1 = psb_get_timer_idx("POLY: Chebychev4")
|
||||||
|
if ((do_timings).and.(poly_2==-1)) &
|
||||||
|
& poly_2 = psb_get_timer_idx("POLY: OptChebychev4")
|
||||||
|
if ((do_timings).and.(poly_3==-1)) &
|
||||||
|
& poly_3 = psb_get_timer_idx("POLY: OptChebychev1")
|
||||||
|
if ((do_timings).and.(poly_mv==-1)) &
|
||||||
|
& poly_mv = psb_get_timer_idx("POLY: spMV")
|
||||||
|
if ((do_timings).and.(poly_vect==-1)) &
|
||||||
|
& poly_vect = psb_get_timer_idx("POLY: Vectors")
|
||||||
|
if ((do_timings).and.(poly_sv==-1)) &
|
||||||
|
& poly_sv = psb_get_timer_idx("POLY: solver")
|
||||||
|
n_row = desc_data%get_local_rows()
|
||||||
|
n_col = desc_data%get_local_cols()
|
||||||
|
|
||||||
|
if (4*n_col <= size(work)) then
|
||||||
|
aux => work(:)
|
||||||
|
else
|
||||||
|
allocate(aux(4*n_col),stat=info)
|
||||||
|
if (info /= psb_success_) then
|
||||||
|
info=psb_err_alloc_request_
|
||||||
|
call psb_errpush(info,name,&
|
||||||
|
& i_err=(/4*n_col,izero,izero,izero,izero/),&
|
||||||
|
& a_err='real(psb_dpk_)')
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (size(wv) < 4) then
|
||||||
|
info = psb_err_internal_error_
|
||||||
|
call psb_errpush(info,name,&
|
||||||
|
& a_err='invalid wv size in smoother_apply')
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
|
||||||
|
associate(tx => wv(1), ty => wv(2), tz => wv(3), r => wv(4))
|
||||||
|
|
||||||
|
call psb_geaxpby(done,x,dzero,r,desc_data,info)
|
||||||
|
call tx%zero()
|
||||||
|
call ty%zero()
|
||||||
|
call tz%zero()
|
||||||
|
|
||||||
|
select case(sm%variant)
|
||||||
|
case(amg_cheb_4_)
|
||||||
|
if (do_timings) call psb_tic(poly_1)
|
||||||
|
block
|
||||||
|
real(psb_dpk_) :: cz, cr
|
||||||
|
! b == x
|
||||||
|
! x == tx
|
||||||
|
!
|
||||||
|
do i=1, sm%pdegree-1
|
||||||
|
! B r_{k-1}
|
||||||
|
if (do_timings) call psb_tic(poly_sv)
|
||||||
|
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') ! ty = M^{-1} r
|
||||||
|
if (do_timings) call psb_toc(poly_sv)
|
||||||
|
cz = (2*i*done-3)/(2*i*done+done)
|
||||||
|
cr = (8*i*done-4)/((2*i*done+done)*sm%rho_ba)
|
||||||
|
if (do_timings) call psb_tic(poly_vect)
|
||||||
|
call psb_abgdxyz(cr,cz,done,done,ty,tz,tx,desc_data,info) ! zk = cz * zk-1 + cr * rk-1
|
||||||
|
if (do_timings) call psb_toc(poly_vect)
|
||||||
|
if (do_timings) call psb_tic(poly_mv)
|
||||||
|
call psb_spmm(-done,sm%pa,tz,done,r,desc_data,info,work=aux,trans=trans_)
|
||||||
|
if (do_timings) call psb_toc(poly_mv)
|
||||||
|
end do
|
||||||
|
if (do_timings) call psb_tic(poly_sv)
|
||||||
|
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') ! ty = M^{-1} r
|
||||||
|
if (do_timings) call psb_toc(poly_sv)
|
||||||
|
cz = (2*sm%pdegree*done-3)/(2*sm%pdegree*done+done)
|
||||||
|
cr = (8*sm%pdegree*done-4)/((2*sm%pdegree*done+done)*sm%rho_ba)
|
||||||
|
if (do_timings) call psb_tic(poly_vect)
|
||||||
|
call psb_abgdxyz(cr,cz,done,done,ty,tz,tx,desc_data,info)
|
||||||
|
if (do_timings) call psb_toc(poly_vect)
|
||||||
|
end block
|
||||||
|
if (do_timings) call psb_toc(poly_1)
|
||||||
|
|
||||||
|
case(amg_cheb_4_opt_)
|
||||||
|
if (do_timings) call psb_tic(poly_2)
|
||||||
|
block
|
||||||
|
real(psb_dpk_) :: cz, cr
|
||||||
|
! b == x
|
||||||
|
! x == tx
|
||||||
|
!
|
||||||
|
if (allocated(sm%poly_beta)) then
|
||||||
|
if (size(sm%poly_beta) /= sm%pdegree) deallocate(sm%poly_beta)
|
||||||
|
end if
|
||||||
|
if (.not.allocated(sm%poly_beta)) then
|
||||||
|
call psb_realloc(sm%pdegree,sm%poly_beta,info)
|
||||||
|
sm%poly_beta(1:sm%pdegree) = amg_d_poly_beta_mat(1:sm%pdegree,sm%pdegree)
|
||||||
|
end if
|
||||||
|
|
||||||
|
do i=1, sm%pdegree-1
|
||||||
|
! B r_{k-1}
|
||||||
|
if (do_timings) call psb_tic(poly_sv)
|
||||||
|
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
|
||||||
|
if (do_timings) call psb_toc(poly_sv)
|
||||||
|
cz = (2*i*done-3)/(2*i*done+done)
|
||||||
|
cr = (8*i*done-4)/((2*i*done+done)*sm%rho_ba)
|
||||||
|
if (do_timings) call psb_tic(poly_vect)
|
||||||
|
call psb_abgdxyz(cr,cz,sm%poly_beta(i),done,ty,tz,tx,desc_data,info)
|
||||||
|
if (do_timings) call psb_toc(poly_vect)
|
||||||
|
if (do_timings) call psb_tic(poly_mv)
|
||||||
|
call psb_spmm(-done,sm%pa,tz,done,r,desc_data,info,work=aux,trans=trans_)
|
||||||
|
if (do_timings) call psb_toc(poly_mv)
|
||||||
|
end do
|
||||||
|
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
|
||||||
|
cz = (2*sm%pdegree*done-3)/(2*sm%pdegree*done+done)
|
||||||
|
cr = (8*sm%pdegree*done-4)/((2*sm%pdegree*done+done)*sm%rho_ba)
|
||||||
|
if (do_timings) call psb_tic(poly_vect)
|
||||||
|
call psb_abgdxyz(cr,cz,sm%poly_beta(sm%pdegree),done,ty,tz,tx,desc_data,info)
|
||||||
|
if (do_timings) call psb_toc(poly_vect)
|
||||||
|
end block
|
||||||
|
if (do_timings) call psb_toc(poly_2)
|
||||||
|
case(amg_cheb_1_opt_)
|
||||||
|
if (do_timings) call psb_tic(poly_3)
|
||||||
|
block
|
||||||
|
real(psb_dpk_) :: sigma, theta, delta, rho_old, rho
|
||||||
|
! b == x
|
||||||
|
! x == tx
|
||||||
|
!
|
||||||
|
|
||||||
|
theta = (done+sm%cf_a)/2
|
||||||
|
delta = (done-sm%cf_a)/2
|
||||||
|
sigma = theta/delta
|
||||||
|
rho_old = done/sigma
|
||||||
|
if (do_timings) call psb_tic(poly_sv)
|
||||||
|
call sm%sv%apply(done,r,dzero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
|
||||||
|
if (do_timings) call psb_toc(poly_sv)
|
||||||
|
call psb_geaxpby((done/sm%rho_ba),ty,dzero,r,desc_data,info)
|
||||||
|
if (do_timings) call psb_tic(poly_vect)
|
||||||
|
call psb_abgdxyz((done/theta),dzero,done,done,r,tz,tx,desc_data,info)
|
||||||
|
if (do_timings) call psb_toc(poly_vect)
|
||||||
|
|
||||||
|
! tz == d
|
||||||
|
do i=1, sm%pdegree-1
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! r_{k-1} = r_k - (1/rho(BA)) B A d_k
|
||||||
|
if (do_timings) call psb_tic(poly_mv)
|
||||||
|
call psb_spmm(done,sm%pa,tz,dzero,ty,desc_data,info,work=aux,trans=trans_)
|
||||||
|
if (do_timings) call psb_toc(poly_mv)
|
||||||
|
if (do_timings) call psb_tic(poly_sv)
|
||||||
|
call sm%sv%apply(-(done/sm%rho_ba),ty,done,r,desc_data,trans_,aux,wv(5:),info,init='Z')
|
||||||
|
if (do_timings) call psb_toc(poly_sv)
|
||||||
|
!
|
||||||
|
! d_{k+1} = (rho rho_old) d_k + 2(rho/delta) r_{k+1}
|
||||||
|
rho = done/(2*sigma - rho_old)
|
||||||
|
if (do_timings) call psb_tic(poly_vect)
|
||||||
|
call psb_abgdxyz((2*rho/delta),(rho*rho_old),done,done,r,tz,tx,desc_data,info)
|
||||||
|
if (do_timings) call psb_toc(poly_vect)
|
||||||
|
rho_old = rho
|
||||||
|
end do
|
||||||
|
end block
|
||||||
|
if (do_timings) call psb_toc(poly_3)
|
||||||
|
case default
|
||||||
|
info=psb_err_internal_error_
|
||||||
|
call psb_errpush(info,name,&
|
||||||
|
& a_err='wrong polynomial variant')
|
||||||
|
goto 9999
|
||||||
|
end select
|
||||||
|
|
||||||
|
if (info == psb_success_) call psb_geaxpby(alpha,tx,beta,y,desc_data,info)
|
||||||
|
|
||||||
|
if (info /= psb_success_) then
|
||||||
|
info=psb_err_internal_error_
|
||||||
|
call psb_errpush(info,name,&
|
||||||
|
& a_err='polynomial smoother')
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
end associate
|
||||||
|
|
||||||
|
if (.not.(4*n_col <= size(work))) then
|
||||||
|
deallocate(aux)
|
||||||
|
endif
|
||||||
|
|
||||||
|
call psb_erractionrestore(err_act)
|
||||||
|
return
|
||||||
|
|
||||||
|
9999 call psb_error_handler(err_act)
|
||||||
|
|
||||||
|
return
|
||||||
|
|
||||||
|
end subroutine amg_d_poly_smoother_apply_vect
|
@ -0,0 +1,179 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
subroutine amg_d_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_d_diag_solver
|
||||||
|
use amg_d_l1_diag_solver
|
||||||
|
use amg_d_poly_coeff_mod
|
||||||
|
use amg_d_poly_smoother, amg_protect_name => amg_d_poly_smoother_bld
|
||||||
|
Implicit None
|
||||||
|
|
||||||
|
! Arguments
|
||||||
|
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
|
||||||
|
! Local variables
|
||||||
|
type(psb_dspmat_type) :: tmpa
|
||||||
|
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
|
||||||
|
type(psb_ctxt_type) :: ctxt
|
||||||
|
real(psb_dpk_), allocatable :: da(:), dsv(:)
|
||||||
|
integer(psb_ipk_) :: np, me, i, err_act, debug_unit, debug_level
|
||||||
|
character(len=20) :: name='d_poly_smoother_bld', ch_err
|
||||||
|
|
||||||
|
info=psb_success_
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
debug_unit = psb_get_debug_unit()
|
||||||
|
debug_level = psb_get_debug_level()
|
||||||
|
ctxt = desc_a%get_context()
|
||||||
|
call psb_info(ctxt, me, np)
|
||||||
|
if (debug_level >= psb_debug_outer_) &
|
||||||
|
& write(debug_unit,*) me,' ',trim(name),' start'
|
||||||
|
|
||||||
|
|
||||||
|
n_row = desc_a%get_local_rows()
|
||||||
|
n_col = desc_a%get_local_cols()
|
||||||
|
nrow_a = a%get_nrows()
|
||||||
|
nztota = a%get_nzeros()
|
||||||
|
select case(sm%variant)
|
||||||
|
case(amg_cheb_4_)
|
||||||
|
! do nothing
|
||||||
|
case(amg_cheb_4_opt_)
|
||||||
|
if ((1<=sm%pdegree).and.(sm%pdegree<=30)) then
|
||||||
|
call psb_realloc(sm%pdegree,sm%poly_beta,info)
|
||||||
|
sm%poly_beta(1:sm%pdegree) = amg_d_poly_beta_mat(1:sm%pdegree,sm%pdegree)
|
||||||
|
else
|
||||||
|
info = psb_err_internal_error_
|
||||||
|
call psb_errpush(info,name,&
|
||||||
|
& a_err='invalid sm%degree for poly_beta')
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
case(amg_cheb_1_opt_)
|
||||||
|
|
||||||
|
if ((1<=sm%pdegree).and.(sm%pdegree<=30)) then
|
||||||
|
!Ok
|
||||||
|
sm%cf_a = amg_d_poly_a_vect(sm%pdegree)
|
||||||
|
else
|
||||||
|
info = psb_err_internal_error_
|
||||||
|
call psb_errpush(info,name,&
|
||||||
|
& a_err='invalid sm%degree for poly_a')
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
|
||||||
|
case default
|
||||||
|
info = psb_err_internal_error_
|
||||||
|
call psb_errpush(info,name,&
|
||||||
|
& a_err='invalid sm%variant')
|
||||||
|
goto 9999
|
||||||
|
end select
|
||||||
|
|
||||||
|
sm%pa => a
|
||||||
|
if (.not.allocated(sm%sv)) then
|
||||||
|
info = psb_err_internal_error_
|
||||||
|
call psb_errpush(info,name,&
|
||||||
|
& a_err='unallocated sm%sv')
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
|
||||||
|
if (info /= psb_success_) then
|
||||||
|
call psb_errpush(psb_err_from_subroutine_,name,&
|
||||||
|
& a_err='sv%build')
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
|
||||||
|
!!$ if (.false.) then
|
||||||
|
!!$ select type(ssv => sm%sv)
|
||||||
|
!!$ class is(amg_d_l1_diag_solver_type)
|
||||||
|
!!$ da = a%arwsum(info)
|
||||||
|
!!$ dsv = ssv%dv%get_vect()
|
||||||
|
!!$ sm%rho_ba = maxval(da(1:n_row)*dsv(1:n_row))
|
||||||
|
!!$ class default
|
||||||
|
!!$ write(0,*) 'PolySmoother BUILD: only L1-Jacobi/L1-DIAG for now ',ssv%get_fmt()
|
||||||
|
!!$ sm%rho_ba = done
|
||||||
|
!!$ end select
|
||||||
|
!!$ else
|
||||||
|
if (sm%rho_ba <= dzero) then
|
||||||
|
select case(sm%rho_estimate)
|
||||||
|
case(amg_poly_rho_est_power_)
|
||||||
|
block
|
||||||
|
type(psb_d_vect_type) :: tq, tt, tz,wv(2)
|
||||||
|
real(psb_dpk_) :: znrm, lambda
|
||||||
|
real(psb_dpk_),allocatable :: work(:)
|
||||||
|
integer(psb_ipk_) :: i, n_cols
|
||||||
|
n_cols = desc_a%get_local_cols()
|
||||||
|
allocate(work(4*n_cols))
|
||||||
|
call psb_geasb(tz,desc_a,info,mold=vmold,scratch=.true.)
|
||||||
|
call psb_geasb(tt,desc_a,info,mold=vmold,scratch=.true.)
|
||||||
|
call psb_geasb(wv(1),desc_a,info,mold=vmold,scratch=.true.)
|
||||||
|
call psb_geasb(wv(2),desc_a,info,mold=vmold,scratch=.true.)
|
||||||
|
call psb_geall(tq,desc_a,info)
|
||||||
|
call tq%set(done)
|
||||||
|
call psb_geasb(tq,desc_a,info,mold=vmold)
|
||||||
|
call psb_spmm(done,a,tq,dzero,tt,desc_a,info) !
|
||||||
|
call sm%sv%apply_v(done,tt,dzero,tz,desc_a,'NoTrans',work,wv,info) ! z_{k+1} = BA q_k
|
||||||
|
do i=1,sm%rho_estimate_iterations
|
||||||
|
znrm = psb_genrm2(tz,desc_a,info) ! znrm = |z_k|_2
|
||||||
|
call psb_geaxpby((done/znrm),tz,dzero,tq,desc_a,info) ! q_k = z_k/znrm
|
||||||
|
call psb_spmm(done,a,tq,dzero,tt,desc_a,info) ! t_{k+1} = BA q_k
|
||||||
|
call sm%sv%apply_v(done,tt,dzero,tz,desc_a,'NoTrans',work,wv,info) ! z_{k+1} = B t_{k+1}
|
||||||
|
lambda = psb_gedot(tq,tz,desc_a,info) ! lambda = q_k^T z_{k+1} = q_k^T BA q_k
|
||||||
|
!write(0,*) 'BLD: lambda estimate ',i,lambda
|
||||||
|
end do
|
||||||
|
sm%rho_ba = lambda
|
||||||
|
end block
|
||||||
|
case default
|
||||||
|
write(0,*) ' Unknown algorithm for RHO(BA) estimate, defaulting to a value of 1.0 '
|
||||||
|
sm%rho_ba = done
|
||||||
|
end select
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (debug_level >= psb_debug_outer_) &
|
||||||
|
& write(debug_unit,*) me,' ',trim(name),' end'
|
||||||
|
|
||||||
|
call psb_erractionrestore(err_act)
|
||||||
|
return
|
||||||
|
|
||||||
|
9999 call psb_error_handler(err_act)
|
||||||
|
|
||||||
|
return
|
||||||
|
|
||||||
|
end subroutine amg_d_poly_smoother_bld
|
@ -0,0 +1,70 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
subroutine amg_d_poly_smoother_clear_data(sm,info)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_d_poly_smoother, amg_protect_name => amg_d_poly_smoother_clear_data
|
||||||
|
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='amg_d_poly_smoother_clear_data'
|
||||||
|
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
|
||||||
|
info = 0
|
||||||
|
sm%pdegree = 0
|
||||||
|
if (allocated(sm%poly_beta)) deallocate(sm%poly_beta)
|
||||||
|
sm%pa => null()
|
||||||
|
if ((info==0).and.allocated(sm%sv)) then
|
||||||
|
call sm%sv%clear_data(info)
|
||||||
|
end if
|
||||||
|
if (info /= 0) then
|
||||||
|
info = psb_err_internal_error_
|
||||||
|
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 amg_d_poly_smoother_clear_data
|
@ -0,0 +1,90 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
subroutine amg_d_poly_smoother_clone(sm,smout,info)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_d_poly_smoother, amg_protect_name => amg_d_poly_smoother_clone
|
||||||
|
|
||||||
|
Implicit None
|
||||||
|
|
||||||
|
! Arguments
|
||||||
|
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
|
||||||
|
! Local variables
|
||||||
|
integer(psb_ipk_) :: err_act
|
||||||
|
|
||||||
|
|
||||||
|
info=psb_success_
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
|
||||||
|
if (allocated(smout)) then
|
||||||
|
call smout%free(info)
|
||||||
|
if (info == psb_success_) deallocate(smout, stat=info)
|
||||||
|
end if
|
||||||
|
if (info == psb_success_) &
|
||||||
|
& allocate(amg_d_poly_smoother_type :: smout, stat=info)
|
||||||
|
if (info /= 0) then
|
||||||
|
info = psb_err_alloc_dealloc_
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
|
||||||
|
select type(smo => smout)
|
||||||
|
type is (amg_d_poly_smoother_type)
|
||||||
|
smo%pdegree = sm%pdegree
|
||||||
|
smo%rho_ba = sm%rho_ba
|
||||||
|
smo%poly_beta = sm%poly_beta
|
||||||
|
smo%pa => sm%pa
|
||||||
|
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||||
|
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||||
|
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||||
|
end if
|
||||||
|
|
||||||
|
class default
|
||||||
|
info = psb_err_internal_error_
|
||||||
|
end select
|
||||||
|
|
||||||
|
if (info /= 0) goto 9999
|
||||||
|
|
||||||
|
call psb_erractionrestore(err_act)
|
||||||
|
return
|
||||||
|
|
||||||
|
9999 call psb_error_handler(err_act)
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine amg_d_poly_smoother_clone
|
@ -0,0 +1,102 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! AMG4PSBLAS version 1.0
|
||||||
|
! Algebraic Multigrid Package
|
||||||
|
! asd 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
subroutine amg_d_poly_smoother_clone_settings(sm,smout,info)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_d_poly_smoother, amg_protect_name => amg_d_poly_smoother_clone_settings
|
||||||
|
Implicit None
|
||||||
|
! Arguments
|
||||||
|
class(amg_d_poly_smoother_type), intent(inout) :: sm
|
||||||
|
class(amg_d_base_smoother_type), intent(inout) :: smout
|
||||||
|
integer(psb_ipk_), intent(out) :: info
|
||||||
|
integer(psb_ipk_) :: err_act
|
||||||
|
character(len=20) :: name='d_poly_smoother_clone_settings'
|
||||||
|
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
|
||||||
|
info = psb_success_
|
||||||
|
|
||||||
|
select type(smout)
|
||||||
|
class is(amg_d_poly_smoother_type)
|
||||||
|
|
||||||
|
smout%pa => null()
|
||||||
|
smout%pdegree = sm%pdegree
|
||||||
|
smout%variant = sm%variant
|
||||||
|
smout%cf_a = sm%cf_a
|
||||||
|
smout%rho_ba = sm%rho_ba
|
||||||
|
smout%rho_estimate = sm%rho_estimate
|
||||||
|
smout%rho_estimate_iterations = sm%rho_estimate_iterations
|
||||||
|
smout%poly_beta = sm%poly_beta
|
||||||
|
|
||||||
|
if (allocated(smout%sv)) then
|
||||||
|
if (.not.same_type_as(sm%sv,smout%sv)) then
|
||||||
|
call smout%sv%free(info)
|
||||||
|
if (info == 0) deallocate(smout%sv,stat=info)
|
||||||
|
end if
|
||||||
|
end if
|
||||||
|
if (info /= 0) then
|
||||||
|
info = psb_err_internal_error_
|
||||||
|
else
|
||||||
|
if (allocated(smout%sv)) then
|
||||||
|
if (same_type_as(sm%sv,smout%sv)) then
|
||||||
|
call sm%sv%clone_settings(smout%sv,info)
|
||||||
|
else
|
||||||
|
info = psb_err_internal_error_
|
||||||
|
end if
|
||||||
|
else
|
||||||
|
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||||
|
if (info == 0) call sm%sv%clone_settings(smout%sv,info)
|
||||||
|
if (info /= 0) info = psb_err_internal_error_
|
||||||
|
end if
|
||||||
|
end if
|
||||||
|
class default
|
||||||
|
info = psb_err_internal_error_
|
||||||
|
end select
|
||||||
|
|
||||||
|
if (info /= 0) then
|
||||||
|
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 amg_d_poly_smoother_clone_settings
|
@ -0,0 +1,77 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
subroutine amg_d_poly_smoother_cnv(sm,info,amold,vmold,imold)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_d_diag_solver
|
||||||
|
use amg_d_poly_smoother, amg_protect_name => amg_d_poly_smoother_cnv
|
||||||
|
Implicit None
|
||||||
|
|
||||||
|
! Arguments
|
||||||
|
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
|
||||||
|
! Local variables
|
||||||
|
integer(psb_ipk_) :: i, err_act, debug_unit, debug_level
|
||||||
|
character(len=20) :: name='d_poly_smoother_cnv', ch_err
|
||||||
|
|
||||||
|
info=psb_success_
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
debug_unit = psb_get_debug_unit()
|
||||||
|
debug_level = psb_get_debug_level()
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
if (allocated(sm%sv)) &
|
||||||
|
& call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold)
|
||||||
|
if (info /= psb_success_) then
|
||||||
|
call psb_errpush(psb_err_from_subroutine_,name,&
|
||||||
|
& a_err='solver cnv')
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
|
||||||
|
call psb_erractionrestore(err_act)
|
||||||
|
return
|
||||||
|
|
||||||
|
9999 call psb_error_handler(err_act)
|
||||||
|
|
||||||
|
return
|
||||||
|
|
||||||
|
end subroutine amg_d_poly_smoother_cnv
|
@ -0,0 +1,76 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
subroutine amg_d_poly_smoother_csetc(sm,what,val,info,idx)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_d_poly_smoother, amg_protect_name => amg_d_poly_smoother_csetc
|
||||||
|
Implicit None
|
||||||
|
! Arguments
|
||||||
|
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
|
||||||
|
integer(psb_ipk_) :: err_act, ival
|
||||||
|
character(len=20) :: name='d_poly_smoother_csetc'
|
||||||
|
|
||||||
|
info = psb_success_
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
|
||||||
|
select case(psb_toupper(trim(what)))
|
||||||
|
case('POLY_VARIANT')
|
||||||
|
call sm%set(what,amg_stringval(val),info,idx=idx)
|
||||||
|
case('POLY_RHO_ESTIMATE')
|
||||||
|
call sm%set(what,amg_stringval(val),info,idx=idx)
|
||||||
|
case default
|
||||||
|
call sm%amg_d_base_smoother_type%set(what,val,info,idx=idx)
|
||||||
|
end select
|
||||||
|
|
||||||
|
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 amg_d_poly_smoother_csetc
|
@ -0,0 +1,92 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
subroutine amg_d_poly_smoother_cseti(sm,what,val,info,idx)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_d_poly_smoother, amg_protect_nam => amg_d_poly_smoother_cseti
|
||||||
|
Implicit None
|
||||||
|
|
||||||
|
! Arguments
|
||||||
|
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
|
||||||
|
integer(psb_ipk_) :: err_act
|
||||||
|
character(len=20) :: name='d_poly_smoother_cseti'
|
||||||
|
|
||||||
|
info = psb_success_
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
|
||||||
|
select case(psb_toupper(what))
|
||||||
|
case('POLY_DEGREE')
|
||||||
|
sm%pdegree = val
|
||||||
|
case('POLY_VARIANT')
|
||||||
|
select case(val)
|
||||||
|
case(amg_cheb_4_,amg_cheb_4_opt_,amg_cheb_1_opt_)
|
||||||
|
sm%variant = val
|
||||||
|
case default
|
||||||
|
write(0,*) 'Invalid choice for POLY_VARIANT, defaulting to amg_cheb_4_',val
|
||||||
|
sm%variant = amg_cheb_4_
|
||||||
|
end select
|
||||||
|
case('POLY_RHO_ESTIMATE')
|
||||||
|
select case(val)
|
||||||
|
case (amg_poly_rho_est_power_)
|
||||||
|
sm%rho_estimate = val
|
||||||
|
case default
|
||||||
|
write(0,*) 'Invalid choice for POLY_RHO_ESTIMATE, defaulting to amg_poly_rho_power'
|
||||||
|
sm%variant = amg_poly_rho_est_power_
|
||||||
|
end select
|
||||||
|
case('POLY_RHO_ESTIMATE_ITERATIONS')
|
||||||
|
if (val>0) then
|
||||||
|
sm%rho_estimate_iterations = val
|
||||||
|
else
|
||||||
|
write(0,*) 'Invalid choice for POLY_RHO_ESTIMATE_ITERATIONS, defaulting to 20'
|
||||||
|
sm%variant = 20
|
||||||
|
end if
|
||||||
|
case default
|
||||||
|
call sm%amg_d_base_smoother_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 amg_d_poly_smoother_cseti
|
@ -0,0 +1,74 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
subroutine amg_d_poly_smoother_csetr(sm,what,val,info,idx)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_d_poly_smoother, amg_protect_nam => amg_d_poly_smoother_csetr
|
||||||
|
Implicit None
|
||||||
|
|
||||||
|
! Arguments
|
||||||
|
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
|
||||||
|
integer(psb_ipk_) :: err_act
|
||||||
|
character(len=20) :: name='d_poly_smoother_csetr'
|
||||||
|
|
||||||
|
info = psb_success_
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
|
||||||
|
select case(psb_toupper(what))
|
||||||
|
case('POLY_RHO_BA')
|
||||||
|
if ((dzero<val).and.(val<=done)) then
|
||||||
|
sm%rho_ba = val
|
||||||
|
else
|
||||||
|
write(0,*) 'Invalid choice for POLY_RHO_BA, defaulting to compute estimate'
|
||||||
|
sm%rho_ba = -done
|
||||||
|
end if
|
||||||
|
case default
|
||||||
|
call sm%amg_d_base_smoother_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 amg_d_poly_smoother_csetr
|
@ -0,0 +1,108 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
subroutine amg_d_poly_smoother_descr(sm,info,iout,coarse,prefix)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_d_diag_solver
|
||||||
|
use amg_d_poly_smoother, amg_protect_name => amg_d_poly_smoother_descr
|
||||||
|
|
||||||
|
Implicit None
|
||||||
|
|
||||||
|
! Arguments
|
||||||
|
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
|
||||||
|
|
||||||
|
! Local variables
|
||||||
|
integer(psb_ipk_) :: err_act
|
||||||
|
character(len=20), parameter :: name='amg_d_poly_smoother_descr'
|
||||||
|
integer(psb_ipk_) :: iout_
|
||||||
|
logical :: coarse_
|
||||||
|
character(1024) :: prefix_
|
||||||
|
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
info = psb_success_
|
||||||
|
if (present(coarse)) then
|
||||||
|
coarse_ = coarse
|
||||||
|
else
|
||||||
|
coarse_ = .false.
|
||||||
|
end if
|
||||||
|
if (present(iout)) then
|
||||||
|
iout_ = iout
|
||||||
|
else
|
||||||
|
iout_ = psb_out_unit
|
||||||
|
endif
|
||||||
|
if (present(prefix)) then
|
||||||
|
prefix_ = prefix
|
||||||
|
else
|
||||||
|
prefix_ = ""
|
||||||
|
end if
|
||||||
|
|
||||||
|
write(iout_,*) trim(prefix_), ' Polynomial smoother '
|
||||||
|
select case(sm%variant)
|
||||||
|
case(amg_cheb_4_)
|
||||||
|
write(iout_,*) trim(prefix_), ' variant: ','CHEB_4'
|
||||||
|
write(iout_,*) trim(prefix_), ' Degree: ',sm%pdegree
|
||||||
|
write(iout_,*) trim(prefix_), ' rho_ba: ',sm%rho_ba
|
||||||
|
case(amg_cheb_4_opt_)
|
||||||
|
write(iout_,*) trim(prefix_), ' variant: ','CHEB_4_OPT'
|
||||||
|
write(iout_,*) trim(prefix_), ' Degree: ',sm%pdegree
|
||||||
|
write(iout_,*) trim(prefix_), ' rho_ba: ',sm%rho_ba
|
||||||
|
if (allocated(sm%poly_beta)) write(iout_,*) trim(prefix_), ' Coefficients: ',sm%poly_beta(1:sm%pdegree)
|
||||||
|
case(amg_cheb_1_opt_)
|
||||||
|
write(iout_,*) trim(prefix_), ' variant: ','CHEB_1_OPT'
|
||||||
|
write(iout_,*) trim(prefix_), ' Degree: ',sm%pdegree
|
||||||
|
write(iout_,*) trim(prefix_), ' rho_ba: ',sm%rho_ba
|
||||||
|
write(iout_,*) trim(prefix_), ' Coefficient: ',sm%cf_a
|
||||||
|
case default
|
||||||
|
write(iout_,*) trim(prefix_), ' variant: ','UNKNOWN???'
|
||||||
|
end select
|
||||||
|
if (allocated(sm%sv)) then
|
||||||
|
write(iout_,*) trim(prefix_), ' Local solver details:'
|
||||||
|
call sm%sv%descr(info,iout_,coarse=coarse,prefix=prefix)
|
||||||
|
end if
|
||||||
|
|
||||||
|
|
||||||
|
call psb_erractionrestore(err_act)
|
||||||
|
return
|
||||||
|
|
||||||
|
9999 call psb_error_handler(err_act)
|
||||||
|
return
|
||||||
|
end subroutine amg_d_poly_smoother_descr
|
@ -0,0 +1,90 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
subroutine amg_d_poly_smoother_dmp(sm,desc,level,info,prefix,head,smoother,solver,global_num)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_d_poly_smoother, amg_protect_nam => amg_d_poly_smoother_dmp
|
||||||
|
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
|
||||||
|
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
|
||||||
|
type(psb_ctxt_type) :: ctxt
|
||||||
|
integer(psb_ipk_) :: iam, np
|
||||||
|
character(len=80) :: prefix_
|
||||||
|
character(len=120) :: fname ! len should be at least 20 more than
|
||||||
|
integer(psb_lpk_), allocatable :: iv(:)
|
||||||
|
logical :: smoother_, global_num_
|
||||||
|
! len of prefix_
|
||||||
|
|
||||||
|
info = 0
|
||||||
|
|
||||||
|
if (present(prefix)) then
|
||||||
|
prefix_ = trim(prefix(1:min(len(prefix),len(prefix_))))
|
||||||
|
else
|
||||||
|
prefix_ = "dump_smth_d"
|
||||||
|
end if
|
||||||
|
ctxt = desc%get_context()
|
||||||
|
call psb_info(ctxt,iam,np)
|
||||||
|
|
||||||
|
if (present(smoother)) then
|
||||||
|
smoother_ = smoother
|
||||||
|
else
|
||||||
|
smoother_ = .false.
|
||||||
|
end if
|
||||||
|
if (present(global_num)) then
|
||||||
|
global_num_ = global_num
|
||||||
|
else
|
||||||
|
global_num_ = .false.
|
||||||
|
end if
|
||||||
|
lname = len_trim(prefix_)
|
||||||
|
fname = trim(prefix_)
|
||||||
|
write(fname(lname+1:lname+5),'(a,i3.3)') '_poly',iam
|
||||||
|
lname = lname + 8
|
||||||
|
! to be completed
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! At base level do nothing for the smoother
|
||||||
|
if (allocated(sm%sv)) &
|
||||||
|
& call sm%sv%dump(desc,level,info,solver=solver,prefix=prefix,global_num=global_num)
|
||||||
|
|
||||||
|
end subroutine amg_d_poly_smoother_dmp
|
@ -0,0 +1,281 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
subroutine amg_s_poly_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||||
|
& sweeps,work,wv,info,init,initu)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_s_diag_solver
|
||||||
|
use psb_base_krylov_conv_mod, only : log_conv
|
||||||
|
use amg_s_poly_smoother, amg_protect_name => amg_s_poly_smoother_apply_vect
|
||||||
|
implicit none
|
||||||
|
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! this is ignored here, the polynomial degree dictates the value
|
||||||
|
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
|
||||||
|
! Timers
|
||||||
|
logical, parameter :: do_timings=.true.
|
||||||
|
integer(psb_ipk_), save :: poly_1=-1, poly_2=-1, poly_3=-1
|
||||||
|
integer(psb_ipk_), save :: poly_mv=-1, poly_sv=-1, poly_vect=-1
|
||||||
|
!
|
||||||
|
integer(psb_ipk_) :: n_row,n_col
|
||||||
|
type(psb_s_vect_type) :: tx, ty, tz, r
|
||||||
|
real(psb_spk_), pointer :: aux(:)
|
||||||
|
type(psb_ctxt_type) :: ctxt
|
||||||
|
integer(psb_ipk_) :: np, me, i, err_act
|
||||||
|
character :: trans_, init_
|
||||||
|
real(psb_spk_) :: res, resdenum
|
||||||
|
character(len=20) :: name='d_poly_smoother_apply_v'
|
||||||
|
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
|
||||||
|
info = psb_success_
|
||||||
|
ctxt = desc_data%get_context()
|
||||||
|
call psb_info(ctxt,me,np)
|
||||||
|
|
||||||
|
|
||||||
|
if (present(init)) then
|
||||||
|
init_ = psb_toupper(init)
|
||||||
|
else
|
||||||
|
init_='Z'
|
||||||
|
end if
|
||||||
|
|
||||||
|
trans_ = psb_toupper(trans)
|
||||||
|
select case(trans_)
|
||||||
|
case('N')
|
||||||
|
case('T','C')
|
||||||
|
case default
|
||||||
|
call psb_errpush(psb_err_iarg_invalid_i_,name)
|
||||||
|
goto 9999
|
||||||
|
end select
|
||||||
|
|
||||||
|
if (.not.allocated(sm%sv)) then
|
||||||
|
info = 1121
|
||||||
|
call psb_errpush(info,name)
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
|
||||||
|
if ((do_timings).and.(poly_1==-1)) &
|
||||||
|
& poly_1 = psb_get_timer_idx("POLY: Chebychev4")
|
||||||
|
if ((do_timings).and.(poly_2==-1)) &
|
||||||
|
& poly_2 = psb_get_timer_idx("POLY: OptChebychev4")
|
||||||
|
if ((do_timings).and.(poly_3==-1)) &
|
||||||
|
& poly_3 = psb_get_timer_idx("POLY: OptChebychev1")
|
||||||
|
if ((do_timings).and.(poly_mv==-1)) &
|
||||||
|
& poly_mv = psb_get_timer_idx("POLY: spMV")
|
||||||
|
if ((do_timings).and.(poly_vect==-1)) &
|
||||||
|
& poly_vect = psb_get_timer_idx("POLY: Vectors")
|
||||||
|
if ((do_timings).and.(poly_sv==-1)) &
|
||||||
|
& poly_sv = psb_get_timer_idx("POLY: solver")
|
||||||
|
n_row = desc_data%get_local_rows()
|
||||||
|
n_col = desc_data%get_local_cols()
|
||||||
|
|
||||||
|
if (4*n_col <= size(work)) then
|
||||||
|
aux => work(:)
|
||||||
|
else
|
||||||
|
allocate(aux(4*n_col),stat=info)
|
||||||
|
if (info /= psb_success_) then
|
||||||
|
info=psb_err_alloc_request_
|
||||||
|
call psb_errpush(info,name,&
|
||||||
|
& i_err=(/4*n_col,izero,izero,izero,izero/),&
|
||||||
|
& a_err='real(psb_spk_)')
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (size(wv) < 4) then
|
||||||
|
info = psb_err_internal_error_
|
||||||
|
call psb_errpush(info,name,&
|
||||||
|
& a_err='invalid wv size in smoother_apply')
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
|
||||||
|
associate(tx => wv(1), ty => wv(2), tz => wv(3), r => wv(4))
|
||||||
|
|
||||||
|
call psb_geaxpby(sone,x,szero,r,desc_data,info)
|
||||||
|
call tx%zero()
|
||||||
|
call ty%zero()
|
||||||
|
call tz%zero()
|
||||||
|
|
||||||
|
select case(sm%variant)
|
||||||
|
case(amg_cheb_4_)
|
||||||
|
if (do_timings) call psb_tic(poly_1)
|
||||||
|
block
|
||||||
|
real(psb_spk_) :: cz, cr
|
||||||
|
! b == x
|
||||||
|
! x == tx
|
||||||
|
!
|
||||||
|
do i=1, sm%pdegree-1
|
||||||
|
! B r_{k-1}
|
||||||
|
if (do_timings) call psb_tic(poly_sv)
|
||||||
|
call sm%sv%apply(sone,r,szero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') ! ty = M^{-1} r
|
||||||
|
if (do_timings) call psb_toc(poly_sv)
|
||||||
|
cz = (2*i*sone-3)/(2*i*sone+sone)
|
||||||
|
cr = (8*i*sone-4)/((2*i*sone+sone)*sm%rho_ba)
|
||||||
|
if (do_timings) call psb_tic(poly_vect)
|
||||||
|
call psb_abgdxyz(cr,cz,sone,sone,ty,tz,tx,desc_data,info) ! zk = cz * zk-1 + cr * rk-1
|
||||||
|
if (do_timings) call psb_toc(poly_vect)
|
||||||
|
if (do_timings) call psb_tic(poly_mv)
|
||||||
|
call psb_spmm(-sone,sm%pa,tz,sone,r,desc_data,info,work=aux,trans=trans_)
|
||||||
|
if (do_timings) call psb_toc(poly_mv)
|
||||||
|
end do
|
||||||
|
if (do_timings) call psb_tic(poly_sv)
|
||||||
|
call sm%sv%apply(sone,r,szero,ty,desc_data,trans_,aux,wv(5:),info,init='Z') ! ty = M^{-1} r
|
||||||
|
if (do_timings) call psb_toc(poly_sv)
|
||||||
|
cz = (2*sm%pdegree*sone-3)/(2*sm%pdegree*sone+sone)
|
||||||
|
cr = (8*sm%pdegree*sone-4)/((2*sm%pdegree*sone+sone)*sm%rho_ba)
|
||||||
|
if (do_timings) call psb_tic(poly_vect)
|
||||||
|
call psb_abgdxyz(cr,cz,sone,sone,ty,tz,tx,desc_data,info)
|
||||||
|
if (do_timings) call psb_toc(poly_vect)
|
||||||
|
end block
|
||||||
|
if (do_timings) call psb_toc(poly_1)
|
||||||
|
|
||||||
|
case(amg_cheb_4_opt_)
|
||||||
|
if (do_timings) call psb_tic(poly_2)
|
||||||
|
block
|
||||||
|
real(psb_spk_) :: cz, cr
|
||||||
|
! b == x
|
||||||
|
! x == tx
|
||||||
|
!
|
||||||
|
if (allocated(sm%poly_beta)) then
|
||||||
|
if (size(sm%poly_beta) /= sm%pdegree) deallocate(sm%poly_beta)
|
||||||
|
end if
|
||||||
|
if (.not.allocated(sm%poly_beta)) then
|
||||||
|
call psb_realloc(sm%pdegree,sm%poly_beta,info)
|
||||||
|
sm%poly_beta(1:sm%pdegree) = amg_d_poly_beta_mat(1:sm%pdegree,sm%pdegree)
|
||||||
|
end if
|
||||||
|
|
||||||
|
do i=1, sm%pdegree-1
|
||||||
|
! B r_{k-1}
|
||||||
|
if (do_timings) call psb_tic(poly_sv)
|
||||||
|
call sm%sv%apply(sone,r,szero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
|
||||||
|
if (do_timings) call psb_toc(poly_sv)
|
||||||
|
cz = (2*i*sone-3)/(2*i*sone+sone)
|
||||||
|
cr = (8*i*sone-4)/((2*i*sone+sone)*sm%rho_ba)
|
||||||
|
if (do_timings) call psb_tic(poly_vect)
|
||||||
|
call psb_abgdxyz(cr,cz,sm%poly_beta(i),sone,ty,tz,tx,desc_data,info)
|
||||||
|
if (do_timings) call psb_toc(poly_vect)
|
||||||
|
if (do_timings) call psb_tic(poly_mv)
|
||||||
|
call psb_spmm(-sone,sm%pa,tz,sone,r,desc_data,info,work=aux,trans=trans_)
|
||||||
|
if (do_timings) call psb_toc(poly_mv)
|
||||||
|
end do
|
||||||
|
call sm%sv%apply(sone,r,szero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
|
||||||
|
cz = (2*sm%pdegree*sone-3)/(2*sm%pdegree*sone+sone)
|
||||||
|
cr = (8*sm%pdegree*sone-4)/((2*sm%pdegree*sone+sone)*sm%rho_ba)
|
||||||
|
if (do_timings) call psb_tic(poly_vect)
|
||||||
|
call psb_abgdxyz(cr,cz,sm%poly_beta(sm%pdegree),sone,ty,tz,tx,desc_data,info)
|
||||||
|
if (do_timings) call psb_toc(poly_vect)
|
||||||
|
end block
|
||||||
|
if (do_timings) call psb_toc(poly_2)
|
||||||
|
case(amg_cheb_1_opt_)
|
||||||
|
if (do_timings) call psb_tic(poly_3)
|
||||||
|
block
|
||||||
|
real(psb_spk_) :: sigma, theta, delta, rho_old, rho
|
||||||
|
! b == x
|
||||||
|
! x == tx
|
||||||
|
!
|
||||||
|
|
||||||
|
theta = (sone+sm%cf_a)/2
|
||||||
|
delta = (sone-sm%cf_a)/2
|
||||||
|
sigma = theta/delta
|
||||||
|
rho_old = sone/sigma
|
||||||
|
if (do_timings) call psb_tic(poly_sv)
|
||||||
|
call sm%sv%apply(sone,r,szero,ty,desc_data,trans_,aux,wv(5:),info,init='Z')
|
||||||
|
if (do_timings) call psb_toc(poly_sv)
|
||||||
|
call psb_geaxpby((sone/sm%rho_ba),ty,szero,r,desc_data,info)
|
||||||
|
if (do_timings) call psb_tic(poly_vect)
|
||||||
|
call psb_abgdxyz((sone/theta),szero,sone,sone,r,tz,tx,desc_data,info)
|
||||||
|
if (do_timings) call psb_toc(poly_vect)
|
||||||
|
|
||||||
|
! tz == d
|
||||||
|
do i=1, sm%pdegree-1
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! r_{k-1} = r_k - (1/rho(BA)) B A d_k
|
||||||
|
if (do_timings) call psb_tic(poly_mv)
|
||||||
|
call psb_spmm(sone,sm%pa,tz,szero,ty,desc_data,info,work=aux,trans=trans_)
|
||||||
|
if (do_timings) call psb_toc(poly_mv)
|
||||||
|
if (do_timings) call psb_tic(poly_sv)
|
||||||
|
call sm%sv%apply(-(sone/sm%rho_ba),ty,sone,r,desc_data,trans_,aux,wv(5:),info,init='Z')
|
||||||
|
if (do_timings) call psb_toc(poly_sv)
|
||||||
|
!
|
||||||
|
! d_{k+1} = (rho rho_old) d_k + 2(rho/delta) r_{k+1}
|
||||||
|
rho = sone/(2*sigma - rho_old)
|
||||||
|
if (do_timings) call psb_tic(poly_vect)
|
||||||
|
call psb_abgdxyz((2*rho/delta),(rho*rho_old),sone,sone,r,tz,tx,desc_data,info)
|
||||||
|
if (do_timings) call psb_toc(poly_vect)
|
||||||
|
rho_old = rho
|
||||||
|
end do
|
||||||
|
end block
|
||||||
|
if (do_timings) call psb_toc(poly_3)
|
||||||
|
case default
|
||||||
|
info=psb_err_internal_error_
|
||||||
|
call psb_errpush(info,name,&
|
||||||
|
& a_err='wrong polynomial variant')
|
||||||
|
goto 9999
|
||||||
|
end select
|
||||||
|
|
||||||
|
if (info == psb_success_) call psb_geaxpby(alpha,tx,beta,y,desc_data,info)
|
||||||
|
|
||||||
|
if (info /= psb_success_) then
|
||||||
|
info=psb_err_internal_error_
|
||||||
|
call psb_errpush(info,name,&
|
||||||
|
& a_err='polynomial smoother')
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
end associate
|
||||||
|
|
||||||
|
if (.not.(4*n_col <= size(work))) then
|
||||||
|
deallocate(aux)
|
||||||
|
endif
|
||||||
|
|
||||||
|
call psb_erractionrestore(err_act)
|
||||||
|
return
|
||||||
|
|
||||||
|
9999 call psb_error_handler(err_act)
|
||||||
|
|
||||||
|
return
|
||||||
|
|
||||||
|
end subroutine amg_s_poly_smoother_apply_vect
|
@ -0,0 +1,179 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
subroutine amg_s_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_s_diag_solver
|
||||||
|
use amg_s_l1_diag_solver
|
||||||
|
use amg_d_poly_coeff_mod
|
||||||
|
use amg_s_poly_smoother, amg_protect_name => amg_s_poly_smoother_bld
|
||||||
|
Implicit None
|
||||||
|
|
||||||
|
! Arguments
|
||||||
|
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
|
||||||
|
! Local variables
|
||||||
|
type(psb_sspmat_type) :: tmpa
|
||||||
|
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
|
||||||
|
type(psb_ctxt_type) :: ctxt
|
||||||
|
real(psb_spk_), allocatable :: da(:), dsv(:)
|
||||||
|
integer(psb_ipk_) :: np, me, i, err_act, debug_unit, debug_level
|
||||||
|
character(len=20) :: name='d_poly_smoother_bld', ch_err
|
||||||
|
|
||||||
|
info=psb_success_
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
debug_unit = psb_get_debug_unit()
|
||||||
|
debug_level = psb_get_debug_level()
|
||||||
|
ctxt = desc_a%get_context()
|
||||||
|
call psb_info(ctxt, me, np)
|
||||||
|
if (debug_level >= psb_debug_outer_) &
|
||||||
|
& write(debug_unit,*) me,' ',trim(name),' start'
|
||||||
|
|
||||||
|
|
||||||
|
n_row = desc_a%get_local_rows()
|
||||||
|
n_col = desc_a%get_local_cols()
|
||||||
|
nrow_a = a%get_nrows()
|
||||||
|
nztota = a%get_nzeros()
|
||||||
|
select case(sm%variant)
|
||||||
|
case(amg_cheb_4_)
|
||||||
|
! do nothing
|
||||||
|
case(amg_cheb_4_opt_)
|
||||||
|
if ((1<=sm%pdegree).and.(sm%pdegree<=30)) then
|
||||||
|
call psb_realloc(sm%pdegree,sm%poly_beta,info)
|
||||||
|
sm%poly_beta(1:sm%pdegree) = amg_d_poly_beta_mat(1:sm%pdegree,sm%pdegree)
|
||||||
|
else
|
||||||
|
info = psb_err_internal_error_
|
||||||
|
call psb_errpush(info,name,&
|
||||||
|
& a_err='invalid sm%degree for poly_beta')
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
case(amg_cheb_1_opt_)
|
||||||
|
|
||||||
|
if ((1<=sm%pdegree).and.(sm%pdegree<=30)) then
|
||||||
|
!Ok
|
||||||
|
sm%cf_a = amg_d_poly_a_vect(sm%pdegree)
|
||||||
|
else
|
||||||
|
info = psb_err_internal_error_
|
||||||
|
call psb_errpush(info,name,&
|
||||||
|
& a_err='invalid sm%degree for poly_a')
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
|
||||||
|
case default
|
||||||
|
info = psb_err_internal_error_
|
||||||
|
call psb_errpush(info,name,&
|
||||||
|
& a_err='invalid sm%variant')
|
||||||
|
goto 9999
|
||||||
|
end select
|
||||||
|
|
||||||
|
sm%pa => a
|
||||||
|
if (.not.allocated(sm%sv)) then
|
||||||
|
info = psb_err_internal_error_
|
||||||
|
call psb_errpush(info,name,&
|
||||||
|
& a_err='unallocated sm%sv')
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
|
||||||
|
if (info /= psb_success_) then
|
||||||
|
call psb_errpush(psb_err_from_subroutine_,name,&
|
||||||
|
& a_err='sv%build')
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
|
||||||
|
!!$ if (.false.) then
|
||||||
|
!!$ select type(ssv => sm%sv)
|
||||||
|
!!$ class is(amg_s_l1_diag_solver_type)
|
||||||
|
!!$ da = a%arwsum(info)
|
||||||
|
!!$ dsv = ssv%dv%get_vect()
|
||||||
|
!!$ sm%rho_ba = maxval(da(1:n_row)*dsv(1:n_row))
|
||||||
|
!!$ class default
|
||||||
|
!!$ write(0,*) 'PolySmoother BUILD: only L1-Jacobi/L1-DIAG for now ',ssv%get_fmt()
|
||||||
|
!!$ sm%rho_ba = sone
|
||||||
|
!!$ end select
|
||||||
|
!!$ else
|
||||||
|
if (sm%rho_ba <= szero) then
|
||||||
|
select case(sm%rho_estimate)
|
||||||
|
case(amg_poly_rho_est_power_)
|
||||||
|
block
|
||||||
|
type(psb_s_vect_type) :: tq, tt, tz,wv(2)
|
||||||
|
real(psb_spk_) :: znrm, lambda
|
||||||
|
real(psb_spk_),allocatable :: work(:)
|
||||||
|
integer(psb_ipk_) :: i, n_cols
|
||||||
|
n_cols = desc_a%get_local_cols()
|
||||||
|
allocate(work(4*n_cols))
|
||||||
|
call psb_geasb(tz,desc_a,info,mold=vmold,scratch=.true.)
|
||||||
|
call psb_geasb(tt,desc_a,info,mold=vmold,scratch=.true.)
|
||||||
|
call psb_geasb(wv(1),desc_a,info,mold=vmold,scratch=.true.)
|
||||||
|
call psb_geasb(wv(2),desc_a,info,mold=vmold,scratch=.true.)
|
||||||
|
call psb_geall(tq,desc_a,info)
|
||||||
|
call tq%set(sone)
|
||||||
|
call psb_geasb(tq,desc_a,info,mold=vmold)
|
||||||
|
call psb_spmm(sone,a,tq,szero,tt,desc_a,info) !
|
||||||
|
call sm%sv%apply_v(sone,tt,szero,tz,desc_a,'NoTrans',work,wv,info) ! z_{k+1} = BA q_k
|
||||||
|
do i=1,sm%rho_estimate_iterations
|
||||||
|
znrm = psb_genrm2(tz,desc_a,info) ! znrm = |z_k|_2
|
||||||
|
call psb_geaxpby((sone/znrm),tz,szero,tq,desc_a,info) ! q_k = z_k/znrm
|
||||||
|
call psb_spmm(sone,a,tq,szero,tt,desc_a,info) ! t_{k+1} = BA q_k
|
||||||
|
call sm%sv%apply_v(sone,tt,szero,tz,desc_a,'NoTrans',work,wv,info) ! z_{k+1} = B t_{k+1}
|
||||||
|
lambda = psb_gedot(tq,tz,desc_a,info) ! lambda = q_k^T z_{k+1} = q_k^T BA q_k
|
||||||
|
!write(0,*) 'BLD: lambda estimate ',i,lambda
|
||||||
|
end do
|
||||||
|
sm%rho_ba = lambda
|
||||||
|
end block
|
||||||
|
case default
|
||||||
|
write(0,*) ' Unknown algorithm for RHO(BA) estimate, defaulting to a value of 1.0 '
|
||||||
|
sm%rho_ba = sone
|
||||||
|
end select
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (debug_level >= psb_debug_outer_) &
|
||||||
|
& write(debug_unit,*) me,' ',trim(name),' end'
|
||||||
|
|
||||||
|
call psb_erractionrestore(err_act)
|
||||||
|
return
|
||||||
|
|
||||||
|
9999 call psb_error_handler(err_act)
|
||||||
|
|
||||||
|
return
|
||||||
|
|
||||||
|
end subroutine amg_s_poly_smoother_bld
|
@ -0,0 +1,70 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
subroutine amg_s_poly_smoother_clear_data(sm,info)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_s_poly_smoother, amg_protect_name => amg_s_poly_smoother_clear_data
|
||||||
|
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='amg_s_poly_smoother_clear_data'
|
||||||
|
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
|
||||||
|
info = 0
|
||||||
|
sm%pdegree = 0
|
||||||
|
if (allocated(sm%poly_beta)) deallocate(sm%poly_beta)
|
||||||
|
sm%pa => null()
|
||||||
|
if ((info==0).and.allocated(sm%sv)) then
|
||||||
|
call sm%sv%clear_data(info)
|
||||||
|
end if
|
||||||
|
if (info /= 0) then
|
||||||
|
info = psb_err_internal_error_
|
||||||
|
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 amg_s_poly_smoother_clear_data
|
@ -0,0 +1,90 @@
|
|||||||
|
!
|
||||||
|
!
|
||||||
|
! 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.
|
||||||
|
!
|
||||||
|
!
|
||||||
|
subroutine amg_s_poly_smoother_clone(sm,smout,info)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use amg_s_poly_smoother, amg_protect_name => amg_s_poly_smoother_clone
|
||||||
|
|
||||||
|
Implicit None
|
||||||
|
|
||||||
|
! Arguments
|
||||||
|
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
|
||||||
|
! Local variables
|
||||||
|
integer(psb_ipk_) :: err_act
|
||||||
|
|
||||||
|
|
||||||
|
info=psb_success_
|
||||||
|
call psb_erractionsave(err_act)
|
||||||
|
|
||||||
|
if (allocated(smout)) then
|
||||||
|
call smout%free(info)
|
||||||
|
if (info == psb_success_) deallocate(smout, stat=info)
|
||||||
|
end if
|
||||||
|
if (info == psb_success_) &
|
||||||
|
& allocate(amg_s_poly_smoother_type :: smout, stat=info)
|
||||||
|
if (info /= 0) then
|
||||||
|
info = psb_err_alloc_dealloc_
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
|
||||||
|
select type(smo => smout)
|
||||||
|
type is (amg_s_poly_smoother_type)
|
||||||
|
smo%pdegree = sm%pdegree
|
||||||
|
smo%rho_ba = sm%rho_ba
|
||||||
|
smo%poly_beta = sm%poly_beta
|
||||||
|
smo%pa => sm%pa
|
||||||
|
if ((info==psb_success_).and.(allocated(sm%sv))) then
|
||||||
|
allocate(smout%sv,mold=sm%sv,stat=info)
|
||||||
|
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
|
||||||
|
end if
|
||||||
|
|
||||||
|
class default
|
||||||
|
info = psb_err_internal_error_
|
||||||
|
end select
|
||||||
|
|
||||||
|
if (info /= 0) goto 9999
|
||||||
|
|
||||||
|
call psb_erractionrestore(err_act)
|
||||||
|
return
|
||||||
|
|
||||||
|
9999 call psb_error_handler(err_act)
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine amg_s_poly_smoother_clone
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue