Compare commits

...
Author SHA1 Message Date
sfilippone c8a70f93a9 Merge branch 'development' into ExperimentMixed 2026-09-15 15:20:07 +02:00
sfilippone 393bff19fb New Mixed version 2026-09-15 15:19:15 +02:00
sfilippone d2122bf4b6 Moving to submodules and fixes for Intel. 2026-09-15 13:36:01 +02:00
Stack-1 eee27acfc1 [ADD] Added mixed precision CG. Now prec is in single and solve is in double. Still needing two matrices, one in single and one in double, so final report for memory occupation does not consider both matrices in CG-MIXED. This should be investigated to avoid copying the matrix. 2026-09-10 13:14:37 +02:00
sfilippone 72a731ca78 Fix test program 2026-09-09 17:20:42 +02:00
sfilippone 243be49a82 Fix test program 2026-09-09 17:19:40 +02:00
sfilippone dccb20652d Invoke D2S in main sample program 2026-09-09 15:34:49 +02:00
sfilippone 5433634f7d Initial psb_mixed_support 2026-09-09 14:27:52 +02:00
sfilippone 4cfd8c6d91 Added psb_mixed_support 2026-09-09 14:23:01 +02:00
sfilippone 83b53884b7 New mixed prec test ground 2026-09-09 13:49:15 +02:00
sfilippone e944da5bf7 Merge branch 'remap-coarse' into development 2026-07-14 15:34:52 +02:00
sfilippone 9cf27f6c46 Fix cmp_avg_cr 2026-07-14 10:53:27 +02:00
sfilippone 8ac5b90454 Cleanup of first remapping version. To be tested. 2026-07-14 09:36:47 +02:00
sfilippone 23f84ce236 First working version 2026-07-13 15:42:23 +02:00
sfilippone 42313bb843 First D remapping version. Needs full testing an work on clone 2026-07-11 12:30:28 +02:00
sfilippone b7ac77da69 Fix poly%clone allocation of poly_beta 2026-07-11 12:27:03 +02:00
sfilippone a3e1be46ee Fix matrix generation 2026-05-05 16:45:06 +02:00
sfilippone 3343b039e6 Fix sample matrix generators 2026-05-05 15:52:03 +02:00
sfilippone 5c055170e7 Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2026-05-05 15:34:47 +02:00
sfilippone 0814492adc Mods jac solver 2026-05-05 15:33:45 +02:00
sfilippone 1ae3cc135f Improve error handling for prec%free 2026-05-04 20:50:34 +02:00
sfilippone 246992cb65 Add base matrix info to prec%descr 2026-04-27 13:04:50 +02:00
sfilippone 01cc7ada88 Adjust strategy for stopping on aggregation ratio 2026-04-27 13:04:04 +02:00
sfilippone 8a66a7b214 Handle remap and refactor mlprec_aply 2026-04-22 16:19:08 +02:00
sfilippone 8f0718c296 Adjust wrk_alloc 2026-04-20 14:29:15 +02:00
sfilippone 62f5501761 Fix mlprec_aply 2026-04-20 11:28:06 +02:00
Salvatore Filippone d833362f4b Round of improvements for remap 2026-04-20 08:45:21 +02:00
Salvatore Filippone f26b66334a Comment on onelev. 2026-04-19 12:49:24 +02:00
Salvatore Filippone d45fffe482 Merged MUMPS fixes 2026-04-19 12:49:11 +02:00
sfilippone 693eab66cb Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2026-04-16 14:59:33 +02:00
sfilippone 1a2ec161d7 Improve configry for MUMPS 2026-04-16 14:59:11 +02:00
sfilippone 4642c857d1 Improve MUMPS solver build 2026-04-16 14:58:59 +02:00
sfilippone f99b563f83 New test cases 2026-04-15 15:13:58 +02:00
sfilippone b1c4b08d6e Fix use of remap 2026-04-15 15:13:04 +02:00
sfilippone c8d065fa55 Fix double allocation in DDIAG%BLD 2026-04-15 10:19:50 +02:00
sfilippone 0e1d7de857 Update VERSION 2026-04-10 13:37:51 +02:00
Salvatore Filippone a22725b787 CMakeLists interim version 2026-04-09 14:37:15 +02:00
sfilippone 74a9ca90cb Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2026-04-07 16:24:04 +02:00
sfilippone 0d38955a2d Fix generation of amg_config.h with CMAKE 2026-04-07 16:23:32 +02:00
fdurastante 9be4a3f1be Updated MUMPS link in documentation 2026-04-02 16:28:42 +02:00
sfilippone 04d7122380 Improved error handling in _bld 2026-04-02 13:53:40 +02:00
Salvatore Filippone 087dc37868 Fix handling of external packages within CBIND. 2026-03-25 16:47:30 +01:00
Salvatore Filippone 8e685aa3ae Fix includes for SuperLU and friends in configure 2026-03-24 19:05:35 +01:00
sfilippone 6dbe4c96f2 Take out amg_const.h 2026-03-24 11:44:11 +01:00
sfilippone f012a9d05e Add cpymat optional argument to hierarchy_bld 2026-03-20 13:48:53 +01:00
sfilippone 93ea03ef1c Add .gitattributes 2026-03-20 10:01:04 +01:00
sfilippone 5663188b8c Fix use of AR in configure for other platforms 2026-03-18 16:58:27 +01:00
sfilippone 8ac05fd00e Fix license 2026-03-18 16:12:44 +01:00
sfilippone c278c2a69a Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2026-03-18 14:51:54 +01:00
sfilippone eae53162af Fix licensing text 2026-03-18 14:46:31 +01:00
sfilippone 0b2a212523 Fix message in samples 2026-03-18 14:29:11 +01:00
sfilippone 7b255aaf6f Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2026-03-17 12:29:48 +01:00
sfilippone 4c9687c89b Multiple changes to CBIND and configure 2026-03-17 12:27:59 +01:00
Salvatore Filippone a1952a5bf8 Merge pull request #8 from fdrmrc/fix_C_interface
Fix missing library in C interface linking
2026-03-17 09:16:17 +01:00
Marco Feder d2070bcc05 Fix Makefile. Add psb_ext 2026-03-17 00:37:59 +01:00
sfilippone f760396403 Fix compilation for new use of MPIC 2026-03-13 14:40:00 +01:00
sfilippone 8f259367de Merge branch 'gpucinterfaces' of github.com:sfilippone/amg4psblas into gpucinterfaces 2026-01-27 14:49:48 +01:00
fdurastante 15d1386b73 Removed debug prints, fixed name of function in error strings 2026-01-27 14:46:35 +01:00
sfilippone 14d24b1d7c Inconsistent C function names 2026-01-27 12:32:46 +01:00
sfilippone 92425e2478 Merge branch 'gpucinterfaces' of github.com:sfilippone/amg4psblas into gpucinterfaces 2026-01-27 12:19:52 +01:00
sfilippone 228f4e46a9 Fix select type 2026-01-27 12:15:14 +01:00
fdurastante 492ae602f2 Added interface for smoother build. Improved options for preconditioner. There is still a memory error. 2026-01-23 14:29:21 +01:00
fdurastante 3230c70308 Standard input file for GPU experiment 2026-01-23 09:40:51 +01:00
fdurastante eb99c74fae Added L1-Jacobi smoother 2026-01-23 08:15:13 +01:00
fdurastante 1c69b2f635 Tester compiling, but misterious CUDA double free to be debugged 2026-01-22 14:35:30 +01:00
sfilippone 86731fe5bb Fix makefiles 2026-01-19 11:46:20 +01:00
fdurastante 7a5ba06622 Added interface for the allocate_wrk member function of a preconditioner. It handles also allocation on the CUDA/GPU side. 2026-01-16 14:08:36 +01:00
sfilippone d4c0428704 Add FCUDEFINES for CBIND 2026-01-16 12:24:22 +01:00
sfilippone 1a969488e3 Merge branch 'gpucinterfaces' of github.com:sfilippone/amg4psblas into gpucinterfaces 2026-01-15 15:27:53 +01:00
Salvatore Filippone 95382fbb01 Fix use of psb_stringc2f 2026-01-15 15:26:11 +01:00
sfilippone f586df1ac3 Fix use of stringc2f 2026-01-15 11:40:36 +01:00
Salvatore Filippone bab8a27962 Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2026-01-13 17:45:52 +01:00
sfilippone 28ccefa4bb Merge branch 'development' of github.com:sfilippone/amg4psblas into development 2026-01-13 17:43:25 +01:00
sfilippone 3f33b2ce71 Update docs 2026-01-13 17:41:47 +01:00
Salvatore Filippone 7279347055 Doc fixes 2025-12-30 19:42:01 +01:00
1014 changed files with 29308 additions and 22113 deletions
+12
View File
@@ -0,0 +1,12 @@
$Format:%d%n%n$
# Fall back version, probably last release:
1.2.1
# AMG4PSBLAS version file.
#
# Release archive created from commit:
# $Format:%H %d$
# $Format:Created on %ci by %cN, and$
# $Format:signed by %GS using %GK.$
# $Format:Signature status: %G?$
$Format:%GG$
+28
View File
@@ -0,0 +1,28 @@
*.a export-ignore
*.o export-ignore
*.mod export-ignore
*.smod export-ignore
*~ export-ignore
.git* export-ignore
Make.inc export-ignore
config export-ignore
config/ export-ignore
config/** export-ignore
configure.ac export-ignore
config.log export-ignore
config.status export-ignore
aclocal.m4 export-ignore
autogen.sh export-ignore
autom4te.cache export-ignore
Dockerfile export-ignore
.travis.yml export-ignore
# generated folder
./include/** export-ignore
./modules/** export-ignore
docs/src export-ignore
docs/doxypsb export-ignore
docs/Makefile export-ignore
# the executable from tests
+15 -11
View File
@@ -13,15 +13,10 @@ endif()
# Check for the installation path for psblas
#if(NOT DEFINED PSBLAS_INSTALL_DIR)
# message(FATAL_ERROR "Please specify the path to the psblas installation directory using -DPSBLAS_INSTALL_DIR=<path>")
#endif()
message(STATUS "psblas directory is ${PSBLAS_INSTALL_DIR};;")
message(STATUS "psblas directory is ${PSBLAS_INSTALL_DIR};")
message(STATUS "PSBLAS DIRECTORY INC ${INCDIR}; MOD ${MODDIR}; LIB ${LIBDIR};")
#set(CMAKE_CXX_STANDARD 17) # Set cxx standard for the c++ part of the library
@@ -31,7 +26,7 @@ find_package(psblas REQUIRED PATHS ${PSBLAS_INSTALL_DIR})
if(NOT psblas_FOUND)
message(FATAL_ERROR "PSBLAS not found!")
else()
message(STATUS "Found PSBLAS: ${psblas_LIBRARIES}")
message(STATUS "Found PSBLAS: ${PSBLAS_LIBRARIES}")
endif()
if(CMAKE_BUILD_TYPE STREQUAL "Debug")
@@ -42,9 +37,9 @@ if(CMAKE_BUILD_TYPE STREQUAL "Debug")
message(STATUS "Fortran and CXX debug flags added: -g")
endif()
string(APPEND CMAKE_Fortran_FLAGS " -O2")
string(APPEND CMAKE_CXX_FLAGS " -O2")
message(STATUS "Fortran and CXX optimization flags added: -O2")
string(APPEND CMAKE_Fortran_FLAGS " -O2")
string(APPEND CMAKE_CXX_FLAGS " -O2")
message(STATUS "Fortran and CXX optimization flags added: -O2")
@@ -305,6 +300,13 @@ if(MPI_FOUND)
#include_directories("${MPI_INCLUDE_DIR}")
endif()
# Find AMG constants
include(${CMAKE_CURRENT_LIST_DIR}/cmake/readAMGConst.cmake)
_amg_read_const()
if ("${PSB_LPK_SIZE}" EQUAL 8)
set(CXXMATCHBOXBIT "#define AMG_MATCHBOXP_BIT64")
endif()
#------------------------------------------
@@ -423,7 +425,9 @@ target_include_directories(amgcbind PUBLIC ${INCDIR} ${MODDIR})
target_link_libraries(amgcbind
#PUBLIC ${LAPACK_LINKER_FLAGS} ${LAPACK_LIBRARIES} ${LAPACK95_LIBRARIES}
#PUBLIC ${BLAS_LINKER_FLAGS} ${BLAS_LIBRARIES} ${BLAS95_LIBRARIES}
PUBLIC amgprec psblas::util psblas::linsolve psblas::prec psblas::ext psblas::cbind psblas::base) #TODO check actual libraries needed
PUBLIC amgprec psblas::util psblas::linsolve psblas::prec
psblas::ext psblas::cbind psblas::base)
#TODO check actual libraries needed
+5 -7
View File
@@ -4,12 +4,10 @@
Algebraic Multigrid Package
based on PSBLAS (Parallel Sparse BLAS version 3.9)
(C) Copyright 2025
Salvatore Filippone
Pasqua D'Ambra
Fabio Durastante
(C) Copyright 2025 Salvatore Filippone
(C) Copyright 2025 Pasqua D'Ambra
(C) Copyright 2025 Fabio Durastante
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
@@ -20,7 +18,7 @@
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.
software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -1
View File
@@ -70,7 +70,8 @@ EXTRALIBS=@EXTRA_LIBS@
#
AMGCDEFINES=$(MUMPSFLAGS) $(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS) $(PSBCDEFINES)
AMGCDEFINES=$(SLUFLAGS) $(UMFFLAGS) $(SLUDISTFLAGS)
#$(PSBCDEFINES) $(MUMPSFLAGS)
CDEFINES=$(AMGCDEFINES)
AMGFDEFINES=@AMGFDEFINES@ $(PSBFDEFINES)
FDEFINES=$(AMGFDEFINES)
+1 -1
View File
@@ -19,7 +19,7 @@ libdir:
amgobjs: mods
cd amgprec && $(MAKE) objs
cbnd: mods
cbnd: amgobjs
cd cbind && $(MAKE) objs
install: all
+5 -4
View File
@@ -58,19 +58,20 @@ MODOBJS=amg_base_prec_type.o amg_prec_type.o amg_prec_mod.o \
$(SMODOBJS) $(DMODOBJS) $(CMODOBJS) $(ZMODOBJS)
LOCAL_MODS=$(MODOBJS:.o=$(.mod))
LOCAL_MODS=$(MODOBJS:.o=$(.mod)) amg_c_l1_diag_solver$(.mod) amg_s_l1_diag_solver$(.mod) \
amg_d_l1_diag_solver$(.mod) amg_z_l1_diag_solver$(.mod)
LIBNAME=libamg_prec.a
all: mods objs impld
mods: $(MODOBJS)
/bin/cp -p amg_const.h amg_config.h $(INCDIR)
/bin/cp -p amg_config.h $(INCDIR)
/bin/cp -p *$(.mod) $(MODDIR)
objs: mods impld
impld: mods
cd impl && $(MAKE)
lib: mods impld
lib: objs
cd impl && $(MAKE) lib
$(AR) $(HERE)/$(LIBNAME) $(MODOBJS)
$(RANLIB) $(HERE)/$(LIBNAME)
@@ -79,7 +80,7 @@ lib: mods impld
$(MODOBJS): $(PSBLAS_MODDIR)/$(PSBBASEMODNAME)$(.mod)
amg_base_prec_type.o: amg_const.h
amg_base_prec_type.o: amg_config.h
amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o : amg_base_prec_type.o
amg_prec_type.o: amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o
amg_prec_mod.o: amg_prec_type.o amg_s_prec_mod.o amg_d_prec_mod.o amg_c_prec_mod.o amg_z_prec_mod.o
-16
View File
@@ -1,16 +0,0 @@
#!/bin/bash
hn=amg_const.h
fn=amg_base_prec_type.F90
echo "/* This file was generated by a script using the $fn file as a basis. */" > $hn
echo '#ifndef AMG_CONST_H_' >> $hn
echo '#define AMG_CONST_H_' >> $hn
echo '#ifdef __cplusplus' >> $hn
echo 'extern "C" { ' >> $hn
echo '#endif' >> $hn
cat $fn | sed 's/=/= (/g;s/$/ )/g' | grep '\(^ *!\)\|parameter' | grep '_\>' | sed 's/^\s*//g;s/^.*:://g;s/\s*=\s*/ /g' | sed 's/,/\n/g;s/^ //g' | tr '[:lower:]' '[:upper:]' | grep ^AMG | sed 's/^/#define /g' >> $hn
echo '#ifdef __cplusplus' >> $hn
echo '}' >> $hn
echo '#endif' >> $hn
echo '#endif' >> $hn
exit
+1 -1
View File
@@ -17,7 +17,7 @@
! documentation and/or other materials provided with the distribution.
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+1 -1
View File
@@ -17,7 +17,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -84,7 +84,7 @@ module amg_base_prec_type
character(len=*), parameter :: amg_version_string_ = "1.2.0"
integer(psb_ipk_), parameter :: amg_version_major_ = 1
integer(psb_ipk_), parameter :: amg_version_minor_ = 2
integer(psb_ipk_), parameter :: amg_patchlevel_ = 0
integer(psb_ipk_), parameter :: amg_patchlevel_ = 1
type amg_ml_parms
integer(psb_ipk_) :: sweeps_pre, sweeps_post
+3 -3
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -103,7 +103,7 @@ module amg_c_ainv_solver
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@@ -225,7 +225,7 @@ module amg_c_ainv_solver
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_d_vect_type, psb_c_base_vect_type, psb_spk_, psb_ipk_
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
integer(psb_ipk_), intent(in) :: fillin,alg
real(psb_spk_), intent(in) :: thresh
type(psb_cspmat_type), intent(inout) :: wmat, zmat
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution.
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -230,7 +230,7 @@ module amg_c_as_smoother
& psb_desc_type, psb_c_base_sparse_mat, psb_ipk_,&
& psb_i_base_vect_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
+6 -7
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -89,7 +89,7 @@ module amg_c_base_aggregator_mod
procedure, pass(ag) :: bld_tprol => amg_c_base_aggregator_build_tprol
procedure, pass(ag) :: mat_bld => amg_c_base_aggregator_mat_bld
procedure, pass(ag) :: mat_asb => amg_c_base_aggregator_mat_asb
procedure, pass(ag) :: bld_map => amg_c_base_aggregator_bld_map
procedure, pass(ag) :: bld_linmap => amg_c_base_aggregator_bld_linmap
procedure, pass(ag) :: update_next => amg_c_base_aggregator_update_next
procedure, pass(ag) :: clone => amg_c_base_aggregator_clone
procedure, pass(ag) :: free => amg_c_base_aggregator_free
@@ -458,7 +458,7 @@ contains
end subroutine amg_c_base_aggregator_mat_asb
!
!> Function bld_map
!> Function bld_linmap
!! \memberof amg_c_base_aggregator_type
!! \brief Build linear map between hierarchy levels
!!
@@ -473,7 +473,7 @@ contains
!! \param map The output map
!! \param info Return code
!!
subroutine amg_c_base_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
subroutine amg_c_base_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
& op_restr,op_prol,map,info)
use psb_base_mod
implicit none
@@ -484,7 +484,7 @@ contains
type(psb_clinmap_type), intent(out) :: map
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_base_aggregator_bld_map'
character(len=20) :: name='c_base_aggregator_bld_linmap'
info = psb_success_
call psb_erractionsave(err_act)
@@ -508,7 +508,6 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine amg_c_base_aggregator_bld_map
end subroutine amg_c_base_aggregator_bld_linmap
end module amg_c_base_aggregator_mod
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -237,7 +237,7 @@ module amg_c_base_smoother_mod
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_base_smoother_type, psb_ipk_, psb_i_base_vect_type
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -170,7 +170,7 @@ module amg_c_base_solver_mod
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+3 -3
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -119,7 +119,7 @@ module amg_c_diag_solver
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@@ -331,7 +331,7 @@ module amg_c_l1_diag_solver
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &
& psb_c_vect_type, psb_c_base_vect_type, psb_spk_, &
& amg_c_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_l1_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -181,7 +181,7 @@ module amg_c_gs_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_gs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@@ -195,7 +195,7 @@ module amg_c_gs_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_bwgs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -123,7 +123,7 @@ contains
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_id_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -144,7 +144,7 @@ module amg_c_ilu_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_ilu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+4 -4
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -56,7 +56,7 @@ module amg_c_inner_mod
& psb_spk_, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
import :: amg_cprec_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(amg_cprec_type), intent(inout), target :: prec
integer(psb_ipk_), intent(out) :: info
@@ -67,7 +67,7 @@ module amg_c_inner_mod
end interface amg_mlprec_bld
interface amg_mlprec_aply
subroutine amg_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
subroutine amg_cmlprec_aply_a(alpha,p,x,beta,y,desc_data,trans,work,info)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
import :: amg_cprec_type
implicit none
@@ -79,7 +79,7 @@ module amg_c_inner_mod
character,intent(in) :: trans
complex(psb_spk_),target :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine amg_cmlprec_aply
end subroutine amg_cmlprec_aply_a
subroutine amg_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
import :: psb_cspmat_type, psb_desc_type, &
& psb_spk_, psb_c_vect_type, psb_ipk_
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution.
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -94,7 +94,7 @@ module amg_c_invk_solver
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_invk_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -94,7 +94,7 @@ module amg_c_invt_solver
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_invt_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -151,7 +151,7 @@ module amg_c_jac_smoother
import :: psb_desc_type, amg_c_jac_smoother_type, psb_c_vect_type, psb_spk_, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
@@ -274,7 +274,7 @@ module amg_c_jac_smoother
import :: psb_desc_type, amg_c_l1_jac_smoother_type, psb_c_vect_type, &
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_l1_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -143,7 +143,7 @@ module amg_c_jac_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@@ -160,7 +160,7 @@ module amg_c_jac_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_l1_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -23,7 +23,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -57,7 +57,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -174,7 +174,7 @@ module amg_c_krm_solver
& psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_krm_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -21,7 +21,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -163,7 +163,7 @@ module amg_c_mumps_solver
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_mumps_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+161 -376
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -154,13 +154,35 @@ module amg_c_onelev_mod
private :: c_wrk_alloc, c_wrk_free, &
& c_wrk_clone, c_wrk_move_alloc, c_wrk_cnv, c_wrk_sizeof
!
! Remap.
! This keeps track of remapping.
! Logic here is as follows:
! 1. AC_PRE_REMAP need to figure out if we
! really need it.
! 2. DESC_AC_PRE_REMAP contains the descriptor before
! remapping. Meaning that it is possible
! to implement the RESTRICTOR operator by
! a. Doing LINMAP_U2V onto this one
! b. For each process, send the data to
! IDEST.
! This assumes that remapping goes by
! a factor of 2.
! For the PROLONGATOR operators, we first
! use DESC_AC, then split and send onto
! the processes in DESC_AC_PRE_REMAP.
!
! To be fixed: what happens if NP the starting processes
! is not an even number? Coordinate with _X_remap in PSBLAS
!
type amg_c_remap_data_type
type(psb_cspmat_type) :: ac_pre_remap
type(psb_desc_type) :: desc_ac_pre_remap
integer(psb_ipk_) :: idest
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
contains
procedure, pass(rmp) :: clone => c_remap_data_clone
procedure, pass(rmp) :: clone => c_remap_data_clone
procedure, pass(rmp) :: move_alloc => c_remap_move_alloc
end type amg_c_remap_data_type
type amg_c_onelev_type
@@ -206,7 +228,7 @@ module amg_c_onelev_mod
procedure, pass(lv) :: get_wrksz => c_base_onelev_get_wrksize
procedure, pass(lv) :: allocate_wrk => c_base_onelev_allocate_wrk
procedure, pass(lv) :: free_wrk => c_base_onelev_free_wrk
procedure, nopass :: stringval => amg_stringval
procedure, nopass :: stringval => amg_stringval
procedure, pass(lv) :: move_alloc => c_base_onelev_move_alloc
@@ -230,9 +252,7 @@ module amg_c_onelev_mod
& c_base_onelev_free_wrk
interface
subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lcspmat_type, psb_lpk_
import :: amg_c_onelev_type
module subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
implicit none
class(amg_c_onelev_type), intent(inout), target :: lv
type(psb_cspmat_type), intent(in) :: a
@@ -244,10 +264,7 @@ module amg_c_onelev_mod
end interface
interface
subroutine amg_c_base_onelev_build(lv,info,amold,vmold,imold,ilv)
import :: psb_c_base_sparse_mat, psb_c_base_vect_type, &
& psb_i_base_vect_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_c_base_onelev_build(lv,info,amold,vmold,imold,ilv)
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
@@ -259,10 +276,7 @@ module amg_c_onelev_mod
end interface
interface
subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
Implicit None
! Arguments
class(amg_c_onelev_type), intent(in) :: lv
@@ -275,10 +289,8 @@ module amg_c_onelev_mod
end interface
interface
subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_c_base_onelev_memory_use(lv,il,nl,ilmin,info,&
& iout,verbosity, prefix,global)
Implicit None
! Arguments
class(amg_c_onelev_type), intent(in) :: lv
@@ -292,10 +304,7 @@ module amg_c_onelev_mod
end interface
interface
subroutine amg_c_base_onelev_cnv(lv,info,amold,vmold,imold)
import :: amg_c_onelev_type, psb_c_base_vect_type, psb_spk_, &
& psb_c_base_sparse_mat, psb_ipk_, psb_i_base_vect_type
! Arguments
module subroutine amg_c_base_onelev_cnv(lv,info,amold,vmold,imold)
class(amg_c_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold
@@ -305,48 +314,32 @@ module amg_c_onelev_mod
end interface
interface
subroutine amg_c_base_onelev_free(lv,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_c_base_onelev_free(lv,info)
implicit none
class(amg_c_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_base_onelev_free
end interface
interface
subroutine amg_c_base_onelev_free_smoothers(lv,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_c_base_onelev_free_smoothers(lv,info)
implicit none
class(amg_c_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_base_onelev_free_smoothers
end interface
interface
subroutine amg_c_base_onelev_check(lv,info)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_c_base_onelev_check(lv,info)
Implicit None
! Arguments
class(amg_c_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_c_base_onelev_check
end interface
interface
subroutine amg_c_base_onelev_setsm(lv,val,info,pos)
import :: psb_spk_, amg_c_onelev_type, amg_c_base_smoother_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_c_base_onelev_setsm(lv,val,info,pos)
Implicit None
! Arguments
class(amg_c_onelev_type), target, intent(inout) :: lv
class(amg_c_base_smoother_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
@@ -355,12 +348,8 @@ module amg_c_onelev_mod
end interface
interface
subroutine amg_c_base_onelev_setsv(lv,val,info,pos)
import :: psb_spk_, amg_c_onelev_type, amg_c_base_solver_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_c_base_onelev_setsv(lv,val,info,pos)
Implicit None
! Arguments
class(amg_c_onelev_type), target, intent(inout) :: lv
class(amg_c_base_solver_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
@@ -369,12 +358,8 @@ module amg_c_onelev_mod
end interface
interface
subroutine amg_c_base_onelev_setag(lv,val,info,pos)
import :: psb_spk_, amg_c_onelev_type, amg_c_base_aggregator_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_c_base_onelev_setag(lv,val,info,pos)
Implicit None
! Arguments
class(amg_c_onelev_type), target, intent(inout) :: lv
class(amg_c_base_aggregator_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
@@ -383,13 +368,8 @@ module amg_c_onelev_mod
end interface
interface
subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_c_base_onelev_cseti(lv,what,val,info,pos,idx)
Implicit None
! Arguments
class(amg_c_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
@@ -400,12 +380,8 @@ module amg_c_onelev_mod
end interface
interface
subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
Implicit None
! Arguments
class(amg_c_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
@@ -416,12 +392,8 @@ module amg_c_onelev_mod
end interface
interface
subroutine amg_c_base_onelev_csetr(lv,what,val,info,pos,idx)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_c_base_onelev_csetr(lv,what,val,info,pos,idx)
Implicit None
class(amg_c_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
@@ -432,11 +404,8 @@ module amg_c_onelev_mod
end interface
interface
subroutine amg_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
module subroutine amg_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
& solver,tprol,global_num)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, amg_c_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none
class(amg_c_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: level
@@ -447,8 +416,7 @@ module amg_c_onelev_mod
end interface
interface
subroutine amg_c_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
import
module subroutine amg_c_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
complex(psb_spk_), intent(in) :: alpha, beta
@@ -457,8 +425,8 @@ module amg_c_onelev_mod
integer(psb_ipk_), intent(out) :: info
complex(psb_spk_), optional :: work(:)
end subroutine amg_c_base_onelev_map_rstr_a
subroutine amg_c_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
import
module subroutine amg_c_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
& work,vtx,vty)
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
complex(psb_spk_), intent(in) :: alpha, beta
@@ -470,8 +438,7 @@ module amg_c_onelev_mod
end interface
interface
subroutine amg_c_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
import
module subroutine amg_c_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
complex(psb_spk_), intent(in) :: alpha, beta
@@ -481,8 +448,8 @@ module amg_c_onelev_mod
complex(psb_spk_), optional :: work(:)
end subroutine amg_c_base_onelev_map_prol_a
subroutine amg_c_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
import
module subroutine amg_c_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,&
& work,vtx,vty)
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
complex(psb_spk_), intent(in) :: alpha, beta
@@ -493,6 +460,118 @@ module amg_c_onelev_mod
end subroutine amg_c_base_onelev_map_prol_v
end interface
interface
module subroutine c_base_onelev_move_alloc(lv, b,info)
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv, b
integer(psb_ipk_), intent(out) :: info
end subroutine c_base_onelev_move_alloc
end interface
interface
module subroutine c_base_onelev_allocate_wrk(lv,info,vmold)
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold
end subroutine c_base_onelev_allocate_wrk
end interface
interface
module subroutine c_base_onelev_free_wrk(lv,info)
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine c_base_onelev_free_wrk
end interface
interface
module subroutine c_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
Implicit None
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold
type(psb_desc_type), intent(in), optional :: desc2
end subroutine c_wrk_alloc
end interface
interface
module subroutine c_inner_do_wrk_alloc(wk,nwv,desc,vmold)
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
class(psb_c_base_vect_type), intent(in), optional :: vmold
end subroutine c_inner_do_wrk_alloc
end interface
interface
module subroutine c_wrk_free(wk,info)
Implicit None
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
end subroutine c_wrk_free
end interface
interface
module subroutine c_wrk_clone(wk,wkout,info)
Implicit None
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
class(amg_cmlprec_wrk_type), target, intent(inout) :: wkout
integer(psb_ipk_), intent(out) :: info
end subroutine c_wrk_clone
end interface
interface
module subroutine c_wrk_move_alloc(wk, b,info)
implicit none
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk, b
integer(psb_ipk_), intent(out) :: info
end subroutine c_wrk_move_alloc
end interface
interface
module subroutine c_wrk_cnv(wk,info,vmold)
Implicit None
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold
end subroutine c_wrk_cnv
end interface
interface
module function c_wrk_sizeof(wk) result(val)
implicit none
class(amg_cmlprec_wrk_type), intent(in) :: wk
integer(psb_epk_) :: val
end function c_wrk_sizeof
end interface
interface
module subroutine c_remap_data_clone(rmp, remap_out, info)
implicit none
! Arguments
class(amg_c_remap_data_type), target, intent(inout) :: rmp
class(amg_c_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
end subroutine c_remap_data_clone
end interface
interface
module subroutine c_remap_move_alloc(rmp, remap_out, info)
implicit none
! Arguments
class(amg_c_remap_data_type), target, intent(inout) :: rmp
class(amg_c_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
end subroutine c_remap_move_alloc
end interface
contains
!
! Function returning the size of the amg_prec_type data structure
@@ -618,7 +697,7 @@ contains
! Arguments
class(amg_c_onelev_type), target, intent(inout) :: lv
class(amg_c_onelev_type), target, intent(inout) :: lvout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (allocated(lv%sm)) then
@@ -660,36 +739,6 @@ contains
end subroutine c_base_onelev_clone
subroutine c_base_onelev_move_alloc(lv, b,info)
use psb_base_mod
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv, b
integer(psb_ipk_), intent(out) :: info
call b%free(info)
b%parms = lv%parms
b%szratio = lv%szratio
if (associated(lv%sm2,lv%sm2a)) then
call move_alloc(lv%sm,b%sm)
call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm2a
else
call move_alloc(lv%sm,b%sm)
call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm
end if
call move_alloc(lv%aggr,b%aggr)
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
b%base_a => lv%base_a
b%base_desc => lv%base_desc
end subroutine c_base_onelev_move_alloc
function c_base_onelev_get_wrksize(lv) result(val)
implicit none
class(amg_c_onelev_type), intent(inout) :: lv
@@ -727,269 +776,5 @@ contains
end function c_base_onelev_get_wrksize
subroutine c_base_onelev_allocate_wrk(lv,info,vmold)
use psb_base_mod
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: nwv, i
info = psb_success_
nwv = lv%get_wrksz()
if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
if (info == 0) then
if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
!
! Need to fix this, we need two different allocations
!
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold,&
& desc2=lv%remap_data%desc_ac_pre_remap)
else
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
end if
end if
end subroutine c_base_onelev_allocate_wrk
subroutine c_base_onelev_free_wrk(lv,info)
use psb_base_mod
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: nwv,i
info = psb_success_
if (allocated(lv%wrk)) then
call lv%wrk%free(info)
if (info == 0) deallocate(lv%wrk,stat=info)
end if
end subroutine c_base_onelev_free_wrk
subroutine c_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
use psb_base_mod
Implicit None
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold
type(psb_desc_type), intent(in), optional :: desc2
!
integer(psb_ipk_) :: i
info = psb_success_
call wk%free(info)
if (present(desc2)) then
!!$ write(0,*) 'Check on wrk_alloc 2',&
!!$ & desc2%get_local_rows(), desc%get_local_rows(),&
!!$ & desc2%get_local_cols(),desc%get_local_cols()
!!$ flush(0)
if (desc2%get_local_cols()>desc%get_local_cols()) then
call psb_geasb(wk%vx2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc2,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc2,info,&
& scratch=.true.,mold=vmold)
end do
else
!!$ write(0,*) 'Check on wrk_alloc 1.5 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
else
!!$ write(0,*) 'Check on wrk_alloc 1 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
end subroutine c_wrk_alloc
subroutine c_wrk_free(wk,info)
Implicit None
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
if (allocated(wk%tx)) deallocate(wk%tx, stat=info)
if (allocated(wk%ty)) deallocate(wk%ty, stat=info)
if (allocated(wk%x2l)) deallocate(wk%x2l, stat=info)
if (allocated(wk%y2l)) deallocate(wk%y2l, stat=info)
call wk%vtx%free(info)
call wk%vty%free(info)
call wk%vx2l%free(info)
call wk%vy2l%free(info)
if (allocated(wk%wv)) then
do i=1,size(wk%wv)
call wk%wv(i)%free(info)
end do
deallocate(wk%wv, stat=info)
end if
end subroutine c_wrk_free
subroutine c_wrk_clone(wk,wkout,info)
use psb_base_mod
Implicit None
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
class(amg_cmlprec_wrk_type), target, intent(inout) :: wkout
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call psb_safe_ab_cpy(wk%tx,wkout%tx,info)
call psb_safe_ab_cpy(wk%ty,wkout%ty,info)
call psb_safe_ab_cpy(wk%x2l,wkout%x2l,info)
call psb_safe_ab_cpy(wk%y2l,wkout%y2l,info)
call wk%vtx%clone(wkout%vtx,info)
call wk%vty%clone(wkout%vty,info)
call wk%vx2l%clone(wkout%vx2l,info)
call wk%vy2l%clone(wkout%vy2l,info)
if (allocated(wkout%wv)) then
do i=1,size(wkout%wv)
call wkout%wv(i)%free(info)
end do
deallocate( wkout%wv)
end if
allocate(wkout%wv(size(wk%wv)),stat=info)
do i=1,size(wk%wv)
call wk%wv(i)%clone(wkout%wv(i),info)
end do
return
end subroutine c_wrk_clone
subroutine c_wrk_move_alloc(wk, b,info)
implicit none
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk, b
integer(psb_ipk_), intent(out) :: info
call b%free(info)
call move_alloc(wk%tx,b%tx)
call move_alloc(wk%ty,b%ty)
call move_alloc(wk%x2l,b%x2l)
call move_alloc(wk%y2l,b%y2l)
!
! Should define V%move_alloc....
call move_alloc(wk%vtx%v,b%vtx%v)
call move_alloc(wk%vty%v,b%vty%v)
call move_alloc(wk%vx2l%v,b%vx2l%v)
call move_alloc(wk%vy2l%v,b%vy2l%v)
call move_alloc(wk%wv,b%wv)
end subroutine c_wrk_move_alloc
subroutine c_wrk_cnv(wk,info,vmold)
use psb_base_mod
Implicit None
! Arguments
class(amg_cmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: i
info = psb_success_
if (present(vmold)) then
call wk%vtx%cnv(vmold)
call wk%vty%cnv(vmold)
call wk%vx2l%cnv(vmold)
call wk%vy2l%cnv(vmold)
if (allocated(wk%wv)) then
do i=1,size(wk%wv)
call wk%wv(i)%cnv(vmold)
end do
end if
end if
end subroutine c_wrk_cnv
function c_wrk_sizeof(wk) result(val)
use psb_realloc_mod
implicit none
class(amg_cmlprec_wrk_type), intent(in) :: wk
integer(psb_epk_) :: val
integer :: i
val = 0
val = val + (1_psb_epk_ * (2*psb_sizeof_sp)) * psb_size(wk%tx)
val = val + (1_psb_epk_ * (2*psb_sizeof_sp)) * psb_size(wk%ty)
val = val + (1_psb_epk_ * (2*psb_sizeof_sp)) * psb_size(wk%x2l)
val = val + (1_psb_epk_ * (2*psb_sizeof_sp)) * psb_size(wk%y2l)
val = val + wk%vtx%sizeof()
val = val + wk%vty%sizeof()
val = val + wk%vx2l%sizeof()
val = val + wk%vy2l%sizeof()
if (allocated(wk%wv)) then
do i=1, size(wk%wv)
val = val + wk%wv(i)%sizeof()
end do
end if
end function c_wrk_sizeof
subroutine c_remap_data_clone(rmp, remap_out, info)
use psb_base_mod
implicit none
! Arguments
class(amg_c_remap_data_type), target, intent(inout) :: rmp
class(amg_c_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
if (info == psb_success_) &
& call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
remap_out%idest = rmp%idest
call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
end subroutine c_remap_data_clone
end module amg_c_onelev_mod
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+47 -40
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -102,6 +102,7 @@ module amg_c_prec_type
! The multilevel hierarchy
!
type(amg_c_onelev_type), allocatable :: precv(:)
integer(psb_ipk_) :: nlevs
contains
procedure, pass(prec) :: psb_c_apply2_vect => amg_c_apply2_vect
procedure, pass(prec) :: psb_c_apply1_vect => amg_c_apply1_vect
@@ -119,6 +120,7 @@ module amg_c_prec_type
procedure, pass(prec) :: cmp_complexity => amg_c_cmp_compl
procedure, pass(prec) :: get_avg_cr => amg_c_get_avg_cr
procedure, pass(prec) :: cmp_avg_cr => amg_c_cmp_avg_cr
procedure, pass(prec) :: set_nlevs => amg_c_set_nlevs
procedure, pass(prec) :: get_nlevs => amg_c_get_nlevs
procedure, pass(prec) :: get_nzeros => amg_c_get_nzeros
procedure, pass(prec) :: sizeof => amg_cprec_sizeof
@@ -311,7 +313,7 @@ module amg_c_prec_type
& psb_c_base_sparse_mat, psb_c_base_vect_type, &
& psb_i_base_vect_type, amg_cprec_type, psb_ipk_
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
class(amg_cprec_type), intent(inout), target :: prec
integer(psb_ipk_), intent(out) :: info
@@ -323,14 +325,15 @@ module amg_c_prec_type
end interface amg_precbld
interface amg_hierarchy_bld
subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& amg_cprec_type, psb_ipk_
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
class(amg_cprec_type), intent(inout), target :: prec
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: cpymat
! character, intent(in),optional :: upd
end subroutine amg_c_hierarchy_bld
end interface amg_hierarchy_bld
@@ -434,10 +437,19 @@ contains
class(amg_cprec_type), intent(in) :: prec
integer(psb_ipk_) :: val
val = 0
if (allocated(prec%precv)) then
val = size(prec%precv)
end if
!!$ if (allocated(prec%precv)) then
!!$ val = size(prec%precv)
!!$ end if
val = prec%nlevs
!!$ write(0,*) ' NLEVS: ',prec%nlevs, val,size(prec%precv)
end function amg_c_get_nlevs
subroutine amg_c_set_nlevs(prec,nl)
implicit none
class(amg_cprec_type), intent(inout) :: prec
integer(psb_ipk_) :: nl
prec%nlevs = nl
end subroutine amg_c_set_nlevs
!
! Function returning the size of the amg_prec_type data structure
! in bytes or in number of nonzeros of the operator(s) involved.
@@ -508,7 +520,7 @@ contains
real(psb_spk_) :: num, den, nmin
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il
integer(psb_ipk_) :: il,nl
num = -sone
den = sone
@@ -518,7 +530,10 @@ contains
num = prec%precv(il)%base_a%get_nzeros()
if (num >= szero) then
den = num
do il=2,size(prec%precv)
nl = prec%get_nlevs()
!!$ write(0,*) 'Inside cmp_compl ',nl,size(prec%precv)
do il=2, nl
!!$ write(0,*) ' ',il,associated(prec%precv(il)%base_a)
num = num + max(0,prec%precv(il)%base_a%get_nzeros())
end do
end if
@@ -549,7 +564,6 @@ contains
end function amg_c_get_avg_cr
subroutine amg_c_cmp_avg_cr(prec)
implicit none
class(amg_cprec_type), intent(inout) :: prec
@@ -557,17 +571,18 @@ contains
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il, nl, iam, np
avgcr = szero
nl = prec%get_nlevs()
do il=2,nl
if (prec%precv(il)%base_desc%is_ok()) then
ctxt = prec%precv(il)%base_desc%get_ctxt()
call psb_info(ctxt,iam,np)
if (iam >=0) avgcr = avgcr + max(szero,prec%precv(il)%szratio)
end if
end do
avgcr = avgcr / (nl-1)
ctxt = prec%ctxt
call psb_info(ctxt,iam,np)
if (allocated(prec%precv)) then
nl = size(prec%precv)
do il=2,nl
avgcr = avgcr + max(szero,prec%precv(il)%szratio)
end do
avgcr = avgcr / (nl-1)
end if
call psb_sum(ctxt,avgcr)
prec%ag_data%avg_cr = avgcr/np
end subroutine amg_c_cmp_avg_cr
@@ -585,9 +600,7 @@ contains
! error code.
!
subroutine amg_cprecfree(p,info)
implicit none
! Arguments
type(amg_cprec_type), intent(inout) :: p
integer(psb_ipk_), intent(out) :: info
@@ -613,9 +626,7 @@ contains
end subroutine amg_cprecfree
subroutine amg_c_prec_free(prec,info)
implicit none
! Arguments
class(amg_cprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -635,6 +646,11 @@ contains
if (allocated(prec%precv)) then
do i=1,size(prec%precv)
call prec%precv(i)%free(info)
if (psb_errstatus_fatal()) then
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
end do
deallocate(prec%precv,stat=info)
end if
@@ -647,9 +663,7 @@ contains
end subroutine amg_c_prec_free
subroutine amg_c_smoothers_free(prec,info)
implicit none
! Arguments
class(amg_cprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -666,7 +680,7 @@ contains
end if
if (allocated(prec%precv)) then
do i=1,size(prec%precv)
do i=1,prec%get_nlevs()
call prec%precv(i)%free_smoothers(info)
end do
end if
@@ -680,9 +694,7 @@ contains
end subroutine amg_c_smoothers_free
subroutine amg_c_hierarchy_free(prec,info)
implicit none
! Arguments
class(amg_cprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -709,7 +721,6 @@ contains
end subroutine amg_c_hierarchy_free
!
! Top level methods.
!
@@ -774,7 +785,6 @@ contains
end subroutine amg_c_apply1_vect
subroutine amg_c_apply2v(prec,x,y,desc_data,info,trans,work)
implicit none
type(psb_desc_type),intent(in) :: desc_data
@@ -839,7 +849,6 @@ contains
subroutine amg_c_dump(prec,info,istart,iend,iproc,prefix,head,&
& ac,rp,smoother,solver,tprol,&
& global_num)
implicit none
class(amg_cprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -856,7 +865,7 @@ contains
info = 0
ctxt = prec%ctxt
call psb_info(ctxt,iam,np)
iln = size(prec%precv)
iln = prec%get_nlevs()
if (present(istart)) then
il1 = max(1,istart)
else
@@ -880,7 +889,6 @@ contains
end subroutine amg_c_dump
subroutine amg_c_cnv(prec,info,amold,vmold,imold)
implicit none
class(amg_cprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -892,7 +900,7 @@ contains
info = psb_success_
if (allocated(prec%precv)) then
do i=1,size(prec%precv)
do i=1,prec%get_nlevs()
if (info == psb_success_ ) &
& call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold)
end do
@@ -901,7 +909,6 @@ contains
end subroutine amg_c_cnv
subroutine amg_c_clone(prec,precout,info)
implicit none
class(amg_cprec_type), intent(inout) :: prec
class(psb_cprec_type), intent(inout) :: precout
@@ -913,7 +920,6 @@ contains
end subroutine amg_c_clone
subroutine amg_c_inner_clone(prec,precout,info)
implicit none
class(amg_cprec_type), intent(inout) :: prec
class(psb_cprec_type), target, intent(inout) :: precout
@@ -929,8 +935,9 @@ contains
pout%ctxt = prec%ctxt
pout%ag_data = prec%ag_data
pout%outer_sweeps = prec%outer_sweeps
pout%nlevs = prec%nlevs
if (allocated(prec%precv)) then
ln = size(prec%precv)
ln = prec%get_nlevs()
allocate(pout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln >= 1) then
@@ -938,6 +945,7 @@ contains
end if
do lev=2, ln
if (info /= psb_success_) exit
!!$ write(0,*) 'Inner_clone must be checked and reimplemented! '
call prec%precv(lev)%clone(pout%precv(lev),info)
if (info == psb_success_) then
pout%precv(lev)%base_a => pout%precv(lev)%ac
@@ -1002,7 +1010,7 @@ contains
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: vmold
!
! In MLD the DESC optional argument is ignored, since
! In AMG the DESC optional argument is ignored, since
! the necessary info is contained in the various entries of the
! PRECV component.
type(psb_desc_type), intent(in), optional :: desc
@@ -1017,7 +1025,7 @@ contains
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
nlev = size(prec%precv)
nlev = prec%get_nlevs()
level = 1
do level = 1, nlev
call prec%precv(level)%allocate_wrk(info,vmold=vmold)
@@ -1040,7 +1048,6 @@ contains
subroutine amg_c_free_wrk(prec,info)
use psb_base_mod
implicit none
! Arguments
class(amg_cprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -1057,7 +1064,7 @@ contains
end if
if (allocated(prec%precv)) then
nlev = size(prec%precv)
nlev = prec%get_nlevs()
do level = 1, nlev
call prec%precv(level)%free_wrk(info)
end do
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -124,7 +124,7 @@ module amg_c_slu_solver
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_c_slu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+6
View File
@@ -3,6 +3,12 @@
#include "psb_config.h"
#define AMG_VERSION_MAJOR @AMGMAJOR@
#define AMG_VERSION_MINOR @AMGMINOR@
#define AMG_VERSION_PATCHLEVEL @AMGPATCH@
#define AMG_VERSION_STRING @AMGSTRING@
@CHAVEUMF@
@CHAVESLU@
@CSLUVERSION@
-107
View File
@@ -1,107 +0,0 @@
/* This file was generated by a script using the mld_base_prec_type.F90 file as a basis. */
#ifndef MLD_CONST_H_
#define MLD_CONST_H_
#ifdef __cplusplus
extern "C" {
#endif
#define MLD_VERSION_STRING_ ( "2.0.0" )
#define MLD_VERSION_MAJOR_ ( 2 )
#define MLD_VERSION_MINOR_ ( 0 )
#define MLD_PATCHLEVEL_ ( 0 )
#define MLD_SMOOTHER_TYPE_ ( 1 )
#define MLD_SUB_SOLVE_ ( 2 )
#define MLD_SUB_RESTR_ ( 3 )
#define MLD_SUB_PROL_ ( 4 )
#define MLD_SUB_REN_ ( 5 )
#define MLD_SUB_OVR_ ( 6 )
#define MLD_SUB_FILLIN_ ( 8 )
#define MLD_SLU_PTR_ ( 10 )
#define MLD_UMF_SYMPTR_ ( 12 )
#define MLD_UMF_NUMPTR_ ( 14 )
#define MLD_SLUD_PTR_ ( 16 )
#define MLD_PREC_STATUS_ ( 18 )
#define MLD_ML_TYPE_ ( 20 )
#define MLD_SMOOTHER_SWEEPS_PRE_ ( 21 )
#define MLD_SMOOTHER_SWEEPS_POST_ ( 22 )
#define MLD_SMOOTHER_POS_ ( 23 )
#define MLD_AGGR_KIND_ ( 24 )
#define MLD_AGGR_ALG_ ( 25 )
#define MLD_AGGR_OMEGA_ALG_ ( 26 )
#define MLD_AGGR_EIG_ ( 27 )
#define MLD_AGGR_FILTER_ ( 28 )
#define MLD_COARSE_MAT_ ( 29 )
#define MLD_COARSE_SOLVE_ ( 30 )
#define MLD_COARSE_SWEEPS_ ( 31 )
#define MLD_COARSE_FILLIN_ ( 32 )
#define MLD_COARSE_SUBSOLVE_ ( 33 )
#define MLD_SMOOTHER_SWEEPS_ ( 34 )
#define MLD_IFPSZ_ ( 36 )
#define MLD_MIN_PREC_ ( 0 )
#define MLD_NOPREC_ ( 0 )
#define MLD_JAC_ ( 1 )
#define MLD_BJAC_ ( 2 )
#define MLD_AS_ ( 3 )
#define MLD_MAX_PREC_ ( 3 )
#define MLD_SLV_DELTA_ ( MLD_MAX_PREC_+1 )
#define MLD_F_NONE_ ( MLD_SLV_DELTA_+0 )
#define MLD_DIAG_SCALE_ ( MLD_SLV_DELTA_+1 )
#define MLD_ILU_N_ ( MLD_SLV_DELTA_+2 )
#define MLD_MILU_N_ ( MLD_SLV_DELTA_+3 )
#define MLD_ILU_T_ ( MLD_SLV_DELTA_+4 )
#define MLD_SLU_ ( MLD_SLV_DELTA_+5 )
#define MLD_UMF_ ( MLD_SLV_DELTA_+6 )
#define MLD_SLUDIST_ ( MLD_SLV_DELTA_+7 )
#define MLD_MAX_SUB_SOLVE_ ( MLD_SLV_DELTA_+7 )
#define MLD_MIN_SUB_SOLVE_ ( MLD_DIAG_SCALE_ )
#define MLD_RENUM_NONE_ (0 )
#define MLD_RENUM_GLB_ (1 )
#define MLD_RENUM_GPS_ (2 )
#define MLD_MAX_RENUM_ (1 )
#define MLD_NO_ML_ ( 0 )
#define MLD_ADD_ML_ ( 1 )
#define MLD_MULT_ML_ ( 2 )
#define MLD_NEW_ML_PREC_ ( 3 )
#define MLD_MAX_ML_TYPE_ ( MLD_MULT_ML_ )
#define MLD_PRE_SMOOTH_ (1 )
#define MLD_POST_SMOOTH_ (2 )
#define MLD_TWOSIDE_SMOOTH_ (3 )
#define MLD_MAX_SMOOTH_ (MLD_TWOSIDE_SMOOTH_ )
#define MLD_NO_SMOOTH_ ( 0 )
#define MLD_SMOOTH_PROL_ ( 1 )
#define MLD_MIN_ENERGY_ ( 2 )
#define MLD_BIZ_PROL_ ( 3 )
#define MLD_MAX_AGGR_KIND_ (MLD_MIN_ENERGY_ )
#define MLD_NO_FILTER_MAT_ (0 )
#define MLD_FILTER_MAT_ (1 )
#define MLD_MAX_FILTER_MAT_ (MLD_NO_FILTER_MAT_ )
#define MLD_DEC_AGGR_ (0 )
#define MLD_SYM_DEC_AGGR_ (1 )
#define MLD_GLB_AGGR_ (2 )
#define MLD_NEW_DEC_AGGR_ (3 )
#define MLD_NEW_GLB_AGGR_ (4 )
#define MLD_MAX_AGGR_ALG_ (MLD_DEC_AGGR_ )
#define MLD_EIG_EST_ (0 )
#define MLD_USER_CHOICE_ (999 )
#define MLD_MAX_NORM_ (0 )
#define MLD_DISTR_MAT_ (0 )
#define MLD_REPL_MAT_ (1 )
#define MLD_MAX_COARSE_MAT_ (MLD_REPL_MAT_ )
#define MLD_PREC_BUILT_ (98765 )
#define MLD_SUB_ILUTHRS_ ( 1 )
#define MLD_AGGR_OMEGA_VAL_ ( 2 )
#define MLD_AGGR_THRESH_ ( 3 )
#define MLD_COARSE_ILUTHRS_ ( 4 )
#define MLD_RFPSZ_ ( 8 )
#define MLD_L_PR_ (1 )
#define MLD_U_PR_ (2 )
#define MLD_BP_ILU_AVSZ_ (2 )
#define MLD_AP_ND_ (3 )
#define MLD_AC_ (4 )
#define MLD_SM_PR_T_ (5 )
#define MLD_SM_PR_ (6 )
#define MLD_SMTH_AVSZ_ (6 )
#define MLD_MAX_AVSZ_ (MLD_SMTH_AVSZ_ )
#ifdef __cplusplus
}
#endif
#endif
+3 -3
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -103,7 +103,7 @@ module amg_d_ainv_solver
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@@ -225,7 +225,7 @@ module amg_d_ainv_solver
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, psb_ipk_
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
integer(psb_ipk_), intent(in) :: fillin,alg
real(psb_dpk_), intent(in) :: thresh
type(psb_dspmat_type), intent(inout) :: wmat, zmat
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution.
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -230,7 +230,7 @@ module amg_d_as_smoother
& psb_desc_type, psb_d_base_sparse_mat, psb_ipk_,&
& psb_i_base_vect_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
+6 -7
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -89,7 +89,7 @@ module amg_d_base_aggregator_mod
procedure, pass(ag) :: bld_tprol => amg_d_base_aggregator_build_tprol
procedure, pass(ag) :: mat_bld => amg_d_base_aggregator_mat_bld
procedure, pass(ag) :: mat_asb => amg_d_base_aggregator_mat_asb
procedure, pass(ag) :: bld_map => amg_d_base_aggregator_bld_map
procedure, pass(ag) :: bld_linmap => amg_d_base_aggregator_bld_linmap
procedure, pass(ag) :: update_next => amg_d_base_aggregator_update_next
procedure, pass(ag) :: clone => amg_d_base_aggregator_clone
procedure, pass(ag) :: free => amg_d_base_aggregator_free
@@ -458,7 +458,7 @@ contains
end subroutine amg_d_base_aggregator_mat_asb
!
!> Function bld_map
!> Function bld_linmap
!! \memberof amg_d_base_aggregator_type
!! \brief Build linear map between hierarchy levels
!!
@@ -473,7 +473,7 @@ contains
!! \param map The output map
!! \param info Return code
!!
subroutine amg_d_base_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
subroutine amg_d_base_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
& op_restr,op_prol,map,info)
use psb_base_mod
implicit none
@@ -484,7 +484,7 @@ contains
type(psb_dlinmap_type), intent(out) :: map
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_aggregator_bld_map'
character(len=20) :: name='d_base_aggregator_bld_linmap'
info = psb_success_
call psb_erractionsave(err_act)
@@ -508,7 +508,6 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine amg_d_base_aggregator_bld_map
end subroutine amg_d_base_aggregator_bld_linmap
end module amg_d_base_aggregator_mod
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -237,7 +237,7 @@ module amg_d_base_smoother_mod
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_base_smoother_type, psb_ipk_, psb_i_base_vect_type
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -170,7 +170,7 @@ module amg_d_base_solver_mod
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+3 -3
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -119,7 +119,7 @@ module amg_d_diag_solver
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@@ -331,7 +331,7 @@ module amg_d_l1_diag_solver
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &
& psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
& amg_d_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_l1_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -181,7 +181,7 @@ module amg_d_gs_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_gs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@@ -195,7 +195,7 @@ module amg_d_gs_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_bwgs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -123,7 +123,7 @@ contains
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_id_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -144,7 +144,7 @@ module amg_d_ilu_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_ilu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+4 -4
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -56,7 +56,7 @@ module amg_d_inner_mod
& psb_dpk_, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
import :: amg_dprec_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(amg_dprec_type), intent(inout), target :: prec
integer(psb_ipk_), intent(out) :: info
@@ -67,7 +67,7 @@ module amg_d_inner_mod
end interface amg_mlprec_bld
interface amg_mlprec_aply
subroutine amg_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
subroutine amg_dmlprec_aply_a(alpha,p,x,beta,y,desc_data,trans,work,info)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
import :: amg_dprec_type
implicit none
@@ -79,7 +79,7 @@ module amg_d_inner_mod
character,intent(in) :: trans
real(psb_dpk_),target :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine amg_dmlprec_aply
end subroutine amg_dmlprec_aply_a
subroutine amg_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
import :: psb_dspmat_type, psb_desc_type, &
& psb_dpk_, psb_d_vect_type, psb_ipk_
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution.
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -94,7 +94,7 @@ module amg_d_invk_solver
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_invk_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -94,7 +94,7 @@ module amg_d_invt_solver
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_invt_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -151,7 +151,7 @@ module amg_d_jac_smoother
import :: psb_desc_type, amg_d_jac_smoother_type, psb_d_vect_type, psb_dpk_, &
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
@@ -274,7 +274,7 @@ module amg_d_jac_smoother
import :: psb_desc_type, amg_d_l1_jac_smoother_type, psb_d_vect_type, &
& 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_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_l1_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -143,7 +143,7 @@ module amg_d_jac_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@@ -160,7 +160,7 @@ module amg_d_jac_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_l1_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -23,7 +23,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -57,7 +57,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -174,7 +174,7 @@ module amg_d_krm_solver
& psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_krm_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -54,7 +54,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -21,7 +21,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -163,7 +163,7 @@ module amg_d_mumps_solver
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_mumps_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+161 -376
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -155,13 +155,35 @@ module amg_d_onelev_mod
private :: d_wrk_alloc, d_wrk_free, &
& d_wrk_clone, d_wrk_move_alloc, d_wrk_cnv, d_wrk_sizeof
!
! Remap.
! This keeps track of remapping.
! Logic here is as follows:
! 1. AC_PRE_REMAP need to figure out if we
! really need it.
! 2. DESC_AC_PRE_REMAP contains the descriptor before
! remapping. Meaning that it is possible
! to implement the RESTRICTOR operator by
! a. Doing LINMAP_U2V onto this one
! b. For each process, send the data to
! IDEST.
! This assumes that remapping goes by
! a factor of 2.
! For the PROLONGATOR operators, we first
! use DESC_AC, then split and send onto
! the processes in DESC_AC_PRE_REMAP.
!
! To be fixed: what happens if NP the starting processes
! is not an even number? Coordinate with _X_remap in PSBLAS
!
type amg_d_remap_data_type
type(psb_dspmat_type) :: ac_pre_remap
type(psb_desc_type) :: desc_ac_pre_remap
integer(psb_ipk_) :: idest
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
contains
procedure, pass(rmp) :: clone => d_remap_data_clone
procedure, pass(rmp) :: clone => d_remap_data_clone
procedure, pass(rmp) :: move_alloc => d_remap_move_alloc
end type amg_d_remap_data_type
type amg_d_onelev_type
@@ -207,7 +229,7 @@ module amg_d_onelev_mod
procedure, pass(lv) :: get_wrksz => d_base_onelev_get_wrksize
procedure, pass(lv) :: allocate_wrk => d_base_onelev_allocate_wrk
procedure, pass(lv) :: free_wrk => d_base_onelev_free_wrk
procedure, nopass :: stringval => amg_stringval
procedure, nopass :: stringval => amg_stringval
procedure, pass(lv) :: move_alloc => d_base_onelev_move_alloc
@@ -231,9 +253,7 @@ module amg_d_onelev_mod
& d_base_onelev_free_wrk
interface
subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_, psb_ldspmat_type, psb_lpk_
import :: amg_d_onelev_type
module subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
implicit none
class(amg_d_onelev_type), intent(inout), target :: lv
type(psb_dspmat_type), intent(in) :: a
@@ -245,10 +265,7 @@ module amg_d_onelev_mod
end interface
interface
subroutine amg_d_base_onelev_build(lv,info,amold,vmold,imold,ilv)
import :: psb_d_base_sparse_mat, psb_d_base_vect_type, &
& psb_i_base_vect_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_d_base_onelev_build(lv,info,amold,vmold,imold,ilv)
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
@@ -260,10 +277,7 @@ module amg_d_onelev_mod
end interface
interface
subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
Implicit None
! Arguments
class(amg_d_onelev_type), intent(in) :: lv
@@ -276,10 +290,8 @@ module amg_d_onelev_mod
end interface
interface
subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_d_base_onelev_memory_use(lv,il,nl,ilmin,info,&
& iout,verbosity, prefix,global)
Implicit None
! Arguments
class(amg_d_onelev_type), intent(in) :: lv
@@ -293,10 +305,7 @@ module amg_d_onelev_mod
end interface
interface
subroutine amg_d_base_onelev_cnv(lv,info,amold,vmold,imold)
import :: amg_d_onelev_type, psb_d_base_vect_type, psb_dpk_, &
& psb_d_base_sparse_mat, psb_ipk_, psb_i_base_vect_type
! Arguments
module subroutine amg_d_base_onelev_cnv(lv,info,amold,vmold,imold)
class(amg_d_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: amold
@@ -306,48 +315,32 @@ module amg_d_onelev_mod
end interface
interface
subroutine amg_d_base_onelev_free(lv,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_d_base_onelev_free(lv,info)
implicit none
class(amg_d_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_base_onelev_free
end interface
interface
subroutine amg_d_base_onelev_free_smoothers(lv,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_d_base_onelev_free_smoothers(lv,info)
implicit none
class(amg_d_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_base_onelev_free_smoothers
end interface
interface
subroutine amg_d_base_onelev_check(lv,info)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_d_base_onelev_check(lv,info)
Implicit None
! Arguments
class(amg_d_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_d_base_onelev_check
end interface
interface
subroutine amg_d_base_onelev_setsm(lv,val,info,pos)
import :: psb_dpk_, amg_d_onelev_type, amg_d_base_smoother_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_d_base_onelev_setsm(lv,val,info,pos)
Implicit None
! Arguments
class(amg_d_onelev_type), target, intent(inout) :: lv
class(amg_d_base_smoother_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
@@ -356,12 +349,8 @@ module amg_d_onelev_mod
end interface
interface
subroutine amg_d_base_onelev_setsv(lv,val,info,pos)
import :: psb_dpk_, amg_d_onelev_type, amg_d_base_solver_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_d_base_onelev_setsv(lv,val,info,pos)
Implicit None
! Arguments
class(amg_d_onelev_type), target, intent(inout) :: lv
class(amg_d_base_solver_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
@@ -370,12 +359,8 @@ module amg_d_onelev_mod
end interface
interface
subroutine amg_d_base_onelev_setag(lv,val,info,pos)
import :: psb_dpk_, amg_d_onelev_type, amg_d_base_aggregator_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_d_base_onelev_setag(lv,val,info,pos)
Implicit None
! Arguments
class(amg_d_onelev_type), target, intent(inout) :: lv
class(amg_d_base_aggregator_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
@@ -384,13 +369,8 @@ module amg_d_onelev_mod
end interface
interface
subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_d_base_onelev_cseti(lv,what,val,info,pos,idx)
Implicit None
! Arguments
class(amg_d_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
@@ -401,12 +381,8 @@ module amg_d_onelev_mod
end interface
interface
subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
Implicit None
! Arguments
class(amg_d_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
@@ -417,12 +393,8 @@ module amg_d_onelev_mod
end interface
interface
subroutine amg_d_base_onelev_csetr(lv,what,val,info,pos,idx)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_d_base_onelev_csetr(lv,what,val,info,pos,idx)
Implicit None
class(amg_d_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
real(psb_dpk_), intent(in) :: val
@@ -433,11 +405,8 @@ module amg_d_onelev_mod
end interface
interface
subroutine amg_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
module subroutine amg_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
& solver,tprol,global_num)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, amg_d_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none
class(amg_d_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: level
@@ -448,8 +417,7 @@ module amg_d_onelev_mod
end interface
interface
subroutine amg_d_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
import
module subroutine amg_d_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
real(psb_dpk_), intent(in) :: alpha, beta
@@ -458,8 +426,8 @@ module amg_d_onelev_mod
integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), optional :: work(:)
end subroutine amg_d_base_onelev_map_rstr_a
subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
import
module subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
& work,vtx,vty)
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
real(psb_dpk_), intent(in) :: alpha, beta
@@ -471,8 +439,7 @@ module amg_d_onelev_mod
end interface
interface
subroutine amg_d_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
import
module subroutine amg_d_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
real(psb_dpk_), intent(in) :: alpha, beta
@@ -482,8 +449,8 @@ module amg_d_onelev_mod
real(psb_dpk_), optional :: work(:)
end subroutine amg_d_base_onelev_map_prol_a
subroutine amg_d_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
import
module subroutine amg_d_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,&
& work,vtx,vty)
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
real(psb_dpk_), intent(in) :: alpha, beta
@@ -494,6 +461,118 @@ module amg_d_onelev_mod
end subroutine amg_d_base_onelev_map_prol_v
end interface
interface
module subroutine d_base_onelev_move_alloc(lv, b,info)
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv, b
integer(psb_ipk_), intent(out) :: info
end subroutine d_base_onelev_move_alloc
end interface
interface
module subroutine d_base_onelev_allocate_wrk(lv,info,vmold)
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold
end subroutine d_base_onelev_allocate_wrk
end interface
interface
module subroutine d_base_onelev_free_wrk(lv,info)
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine d_base_onelev_free_wrk
end interface
interface
module subroutine d_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
Implicit None
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold
type(psb_desc_type), intent(in), optional :: desc2
end subroutine d_wrk_alloc
end interface
interface
module subroutine d_inner_do_wrk_alloc(wk,nwv,desc,vmold)
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
class(psb_d_base_vect_type), intent(in), optional :: vmold
end subroutine d_inner_do_wrk_alloc
end interface
interface
module subroutine d_wrk_free(wk,info)
Implicit None
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
end subroutine d_wrk_free
end interface
interface
module subroutine d_wrk_clone(wk,wkout,info)
Implicit None
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
class(amg_dmlprec_wrk_type), target, intent(inout) :: wkout
integer(psb_ipk_), intent(out) :: info
end subroutine d_wrk_clone
end interface
interface
module subroutine d_wrk_move_alloc(wk, b,info)
implicit none
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk, b
integer(psb_ipk_), intent(out) :: info
end subroutine d_wrk_move_alloc
end interface
interface
module subroutine d_wrk_cnv(wk,info,vmold)
Implicit None
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold
end subroutine d_wrk_cnv
end interface
interface
module function d_wrk_sizeof(wk) result(val)
implicit none
class(amg_dmlprec_wrk_type), intent(in) :: wk
integer(psb_epk_) :: val
end function d_wrk_sizeof
end interface
interface
module subroutine d_remap_data_clone(rmp, remap_out, info)
implicit none
! Arguments
class(amg_d_remap_data_type), target, intent(inout) :: rmp
class(amg_d_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
end subroutine d_remap_data_clone
end interface
interface
module subroutine d_remap_move_alloc(rmp, remap_out, info)
implicit none
! Arguments
class(amg_d_remap_data_type), target, intent(inout) :: rmp
class(amg_d_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
end subroutine d_remap_move_alloc
end interface
contains
!
! Function returning the size of the amg_prec_type data structure
@@ -619,7 +698,7 @@ contains
! Arguments
class(amg_d_onelev_type), target, intent(inout) :: lv
class(amg_d_onelev_type), target, intent(inout) :: lvout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (allocated(lv%sm)) then
@@ -661,36 +740,6 @@ contains
end subroutine d_base_onelev_clone
subroutine d_base_onelev_move_alloc(lv, b,info)
use psb_base_mod
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv, b
integer(psb_ipk_), intent(out) :: info
call b%free(info)
b%parms = lv%parms
b%szratio = lv%szratio
if (associated(lv%sm2,lv%sm2a)) then
call move_alloc(lv%sm,b%sm)
call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm2a
else
call move_alloc(lv%sm,b%sm)
call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm
end if
call move_alloc(lv%aggr,b%aggr)
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
b%base_a => lv%base_a
b%base_desc => lv%base_desc
end subroutine d_base_onelev_move_alloc
function d_base_onelev_get_wrksize(lv) result(val)
implicit none
class(amg_d_onelev_type), intent(inout) :: lv
@@ -728,269 +777,5 @@ contains
end function d_base_onelev_get_wrksize
subroutine d_base_onelev_allocate_wrk(lv,info,vmold)
use psb_base_mod
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: nwv, i
info = psb_success_
nwv = lv%get_wrksz()
if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
if (info == 0) then
if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
!
! Need to fix this, we need two different allocations
!
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold,&
& desc2=lv%remap_data%desc_ac_pre_remap)
else
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
end if
end if
end subroutine d_base_onelev_allocate_wrk
subroutine d_base_onelev_free_wrk(lv,info)
use psb_base_mod
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: nwv,i
info = psb_success_
if (allocated(lv%wrk)) then
call lv%wrk%free(info)
if (info == 0) deallocate(lv%wrk,stat=info)
end if
end subroutine d_base_onelev_free_wrk
subroutine d_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
use psb_base_mod
Implicit None
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold
type(psb_desc_type), intent(in), optional :: desc2
!
integer(psb_ipk_) :: i
info = psb_success_
call wk%free(info)
if (present(desc2)) then
!!$ write(0,*) 'Check on wrk_alloc 2',&
!!$ & desc2%get_local_rows(), desc%get_local_rows(),&
!!$ & desc2%get_local_cols(),desc%get_local_cols()
!!$ flush(0)
if (desc2%get_local_cols()>desc%get_local_cols()) then
call psb_geasb(wk%vx2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc2,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc2,info,&
& scratch=.true.,mold=vmold)
end do
else
!!$ write(0,*) 'Check on wrk_alloc 1.5 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
else
!!$ write(0,*) 'Check on wrk_alloc 1 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
end subroutine d_wrk_alloc
subroutine d_wrk_free(wk,info)
Implicit None
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
if (allocated(wk%tx)) deallocate(wk%tx, stat=info)
if (allocated(wk%ty)) deallocate(wk%ty, stat=info)
if (allocated(wk%x2l)) deallocate(wk%x2l, stat=info)
if (allocated(wk%y2l)) deallocate(wk%y2l, stat=info)
call wk%vtx%free(info)
call wk%vty%free(info)
call wk%vx2l%free(info)
call wk%vy2l%free(info)
if (allocated(wk%wv)) then
do i=1,size(wk%wv)
call wk%wv(i)%free(info)
end do
deallocate(wk%wv, stat=info)
end if
end subroutine d_wrk_free
subroutine d_wrk_clone(wk,wkout,info)
use psb_base_mod
Implicit None
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
class(amg_dmlprec_wrk_type), target, intent(inout) :: wkout
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call psb_safe_ab_cpy(wk%tx,wkout%tx,info)
call psb_safe_ab_cpy(wk%ty,wkout%ty,info)
call psb_safe_ab_cpy(wk%x2l,wkout%x2l,info)
call psb_safe_ab_cpy(wk%y2l,wkout%y2l,info)
call wk%vtx%clone(wkout%vtx,info)
call wk%vty%clone(wkout%vty,info)
call wk%vx2l%clone(wkout%vx2l,info)
call wk%vy2l%clone(wkout%vy2l,info)
if (allocated(wkout%wv)) then
do i=1,size(wkout%wv)
call wkout%wv(i)%free(info)
end do
deallocate( wkout%wv)
end if
allocate(wkout%wv(size(wk%wv)),stat=info)
do i=1,size(wk%wv)
call wk%wv(i)%clone(wkout%wv(i),info)
end do
return
end subroutine d_wrk_clone
subroutine d_wrk_move_alloc(wk, b,info)
implicit none
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk, b
integer(psb_ipk_), intent(out) :: info
call b%free(info)
call move_alloc(wk%tx,b%tx)
call move_alloc(wk%ty,b%ty)
call move_alloc(wk%x2l,b%x2l)
call move_alloc(wk%y2l,b%y2l)
!
! Should define V%move_alloc....
call move_alloc(wk%vtx%v,b%vtx%v)
call move_alloc(wk%vty%v,b%vty%v)
call move_alloc(wk%vx2l%v,b%vx2l%v)
call move_alloc(wk%vy2l%v,b%vy2l%v)
call move_alloc(wk%wv,b%wv)
end subroutine d_wrk_move_alloc
subroutine d_wrk_cnv(wk,info,vmold)
use psb_base_mod
Implicit None
! Arguments
class(amg_dmlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: i
info = psb_success_
if (present(vmold)) then
call wk%vtx%cnv(vmold)
call wk%vty%cnv(vmold)
call wk%vx2l%cnv(vmold)
call wk%vy2l%cnv(vmold)
if (allocated(wk%wv)) then
do i=1,size(wk%wv)
call wk%wv(i)%cnv(vmold)
end do
end if
end if
end subroutine d_wrk_cnv
function d_wrk_sizeof(wk) result(val)
use psb_realloc_mod
implicit none
class(amg_dmlprec_wrk_type), intent(in) :: wk
integer(psb_epk_) :: val
integer :: i
val = 0
val = val + (1_psb_epk_ * psb_sizeof_dp) * psb_size(wk%tx)
val = val + (1_psb_epk_ * psb_sizeof_dp) * psb_size(wk%ty)
val = val + (1_psb_epk_ * psb_sizeof_dp) * psb_size(wk%x2l)
val = val + (1_psb_epk_ * psb_sizeof_dp) * psb_size(wk%y2l)
val = val + wk%vtx%sizeof()
val = val + wk%vty%sizeof()
val = val + wk%vx2l%sizeof()
val = val + wk%vy2l%sizeof()
if (allocated(wk%wv)) then
do i=1, size(wk%wv)
val = val + wk%wv(i)%sizeof()
end do
end if
end function d_wrk_sizeof
subroutine d_remap_data_clone(rmp, remap_out, info)
use psb_base_mod
implicit none
! Arguments
class(amg_d_remap_data_type), target, intent(inout) :: rmp
class(amg_d_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
if (info == psb_success_) &
& call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
remap_out%idest = rmp%idest
call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
end subroutine d_remap_data_clone
end module amg_d_onelev_mod
+6 -6
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -54,7 +54,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -136,7 +136,7 @@ module amg_d_parmatch_aggregator_mod
procedure, pass(ag) :: mat_bld => amg_d_parmatch_aggregator_mat_bld
procedure, pass(ag) :: mat_asb => amg_d_parmatch_aggregator_mat_asb
procedure, pass(ag) :: inner_mat_asb => amg_d_parmatch_aggregator_inner_mat_asb
procedure, pass(ag) :: bld_map => amg_d_parmatch_aggregator_bld_map
procedure, pass(ag) :: bld_linmap => amg_d_parmatch_aggregator_bld_linmap
procedure, pass(ag) :: csetc => amg_d_parmatch_aggr_csetc
procedure, pass(ag) :: cseti => amg_d_parmatch_aggr_cseti
procedure, pass(ag) :: default => amg_d_parmatch_aggr_set_default
@@ -643,7 +643,7 @@ contains
end select
end subroutine amg_d_parmatch_aggregator_clone
subroutine amg_d_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
subroutine amg_d_parmatch_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
& op_restr,op_prol,map,info)
use psb_base_mod
implicit none
@@ -654,7 +654,7 @@ contains
type(psb_dlinmap_type), intent(out) :: map
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_parmatch_aggregator_bld_map'
character(len=20) :: name='d_parmatch_aggregator_bld_linmap'
info = psb_success_
call psb_erractionsave(err_act)
@@ -680,5 +680,5 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine amg_d_parmatch_aggregator_bld_map
end subroutine amg_d_parmatch_aggregator_bld_linmap
end module amg_d_parmatch_aggregator_mod
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -140,7 +140,7 @@ module amg_d_poly_smoother
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_dspmat_type), intent(inout), 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
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+47 -40
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -102,6 +102,7 @@ module amg_d_prec_type
! The multilevel hierarchy
!
type(amg_d_onelev_type), allocatable :: precv(:)
integer(psb_ipk_) :: nlevs
contains
procedure, pass(prec) :: psb_d_apply2_vect => amg_d_apply2_vect
procedure, pass(prec) :: psb_d_apply1_vect => amg_d_apply1_vect
@@ -119,6 +120,7 @@ module amg_d_prec_type
procedure, pass(prec) :: cmp_complexity => amg_d_cmp_compl
procedure, pass(prec) :: get_avg_cr => amg_d_get_avg_cr
procedure, pass(prec) :: cmp_avg_cr => amg_d_cmp_avg_cr
procedure, pass(prec) :: set_nlevs => amg_d_set_nlevs
procedure, pass(prec) :: get_nlevs => amg_d_get_nlevs
procedure, pass(prec) :: get_nzeros => amg_d_get_nzeros
procedure, pass(prec) :: sizeof => amg_dprec_sizeof
@@ -311,7 +313,7 @@ module amg_d_prec_type
& psb_d_base_sparse_mat, psb_d_base_vect_type, &
& psb_i_base_vect_type, amg_dprec_type, psb_ipk_
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
class(amg_dprec_type), intent(inout), target :: prec
integer(psb_ipk_), intent(out) :: info
@@ -323,14 +325,15 @@ module amg_d_prec_type
end interface amg_precbld
interface amg_hierarchy_bld
subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
& amg_dprec_type, psb_ipk_
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
class(amg_dprec_type), intent(inout), target :: prec
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: cpymat
! character, intent(in),optional :: upd
end subroutine amg_d_hierarchy_bld
end interface amg_hierarchy_bld
@@ -434,10 +437,19 @@ contains
class(amg_dprec_type), intent(in) :: prec
integer(psb_ipk_) :: val
val = 0
if (allocated(prec%precv)) then
val = size(prec%precv)
end if
!!$ if (allocated(prec%precv)) then
!!$ val = size(prec%precv)
!!$ end if
val = prec%nlevs
!!$ write(0,*) ' NLEVS: ',prec%nlevs, val,size(prec%precv)
end function amg_d_get_nlevs
subroutine amg_d_set_nlevs(prec,nl)
implicit none
class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_) :: nl
prec%nlevs = nl
end subroutine amg_d_set_nlevs
!
! Function returning the size of the amg_prec_type data structure
! in bytes or in number of nonzeros of the operator(s) involved.
@@ -508,7 +520,7 @@ contains
real(psb_dpk_) :: num, den, nmin
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il
integer(psb_ipk_) :: il,nl
num = -done
den = done
@@ -518,7 +530,10 @@ contains
num = prec%precv(il)%base_a%get_nzeros()
if (num >= dzero) then
den = num
do il=2,size(prec%precv)
nl = prec%get_nlevs()
!!$ write(0,*) 'Inside cmp_compl ',nl,size(prec%precv)
do il=2, nl
!!$ write(0,*) ' ',il,associated(prec%precv(il)%base_a)
num = num + max(0,prec%precv(il)%base_a%get_nzeros())
end do
end if
@@ -549,7 +564,6 @@ contains
end function amg_d_get_avg_cr
subroutine amg_d_cmp_avg_cr(prec)
implicit none
class(amg_dprec_type), intent(inout) :: prec
@@ -557,17 +571,18 @@ contains
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il, nl, iam, np
avgcr = dzero
nl = prec%get_nlevs()
do il=2,nl
if (prec%precv(il)%base_desc%is_ok()) then
ctxt = prec%precv(il)%base_desc%get_ctxt()
call psb_info(ctxt,iam,np)
if (iam >=0) avgcr = avgcr + max(dzero,prec%precv(il)%szratio)
end if
end do
avgcr = avgcr / (nl-1)
ctxt = prec%ctxt
call psb_info(ctxt,iam,np)
if (allocated(prec%precv)) then
nl = size(prec%precv)
do il=2,nl
avgcr = avgcr + max(dzero,prec%precv(il)%szratio)
end do
avgcr = avgcr / (nl-1)
end if
call psb_sum(ctxt,avgcr)
prec%ag_data%avg_cr = avgcr/np
end subroutine amg_d_cmp_avg_cr
@@ -585,9 +600,7 @@ contains
! error code.
!
subroutine amg_dprecfree(p,info)
implicit none
! Arguments
type(amg_dprec_type), intent(inout) :: p
integer(psb_ipk_), intent(out) :: info
@@ -613,9 +626,7 @@ contains
end subroutine amg_dprecfree
subroutine amg_d_prec_free(prec,info)
implicit none
! Arguments
class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -635,6 +646,11 @@ contains
if (allocated(prec%precv)) then
do i=1,size(prec%precv)
call prec%precv(i)%free(info)
if (psb_errstatus_fatal()) then
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
end do
deallocate(prec%precv,stat=info)
end if
@@ -647,9 +663,7 @@ contains
end subroutine amg_d_prec_free
subroutine amg_d_smoothers_free(prec,info)
implicit none
! Arguments
class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -666,7 +680,7 @@ contains
end if
if (allocated(prec%precv)) then
do i=1,size(prec%precv)
do i=1,prec%get_nlevs()
call prec%precv(i)%free_smoothers(info)
end do
end if
@@ -680,9 +694,7 @@ contains
end subroutine amg_d_smoothers_free
subroutine amg_d_hierarchy_free(prec,info)
implicit none
! Arguments
class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -709,7 +721,6 @@ contains
end subroutine amg_d_hierarchy_free
!
! Top level methods.
!
@@ -774,7 +785,6 @@ contains
end subroutine amg_d_apply1_vect
subroutine amg_d_apply2v(prec,x,y,desc_data,info,trans,work)
implicit none
type(psb_desc_type),intent(in) :: desc_data
@@ -839,7 +849,6 @@ contains
subroutine amg_d_dump(prec,info,istart,iend,iproc,prefix,head,&
& ac,rp,smoother,solver,tprol,&
& global_num)
implicit none
class(amg_dprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -856,7 +865,7 @@ contains
info = 0
ctxt = prec%ctxt
call psb_info(ctxt,iam,np)
iln = size(prec%precv)
iln = prec%get_nlevs()
if (present(istart)) then
il1 = max(1,istart)
else
@@ -880,7 +889,6 @@ contains
end subroutine amg_d_dump
subroutine amg_d_cnv(prec,info,amold,vmold,imold)
implicit none
class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -892,7 +900,7 @@ contains
info = psb_success_
if (allocated(prec%precv)) then
do i=1,size(prec%precv)
do i=1,prec%get_nlevs()
if (info == psb_success_ ) &
& call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold)
end do
@@ -901,7 +909,6 @@ contains
end subroutine amg_d_cnv
subroutine amg_d_clone(prec,precout,info)
implicit none
class(amg_dprec_type), intent(inout) :: prec
class(psb_dprec_type), intent(inout) :: precout
@@ -913,7 +920,6 @@ contains
end subroutine amg_d_clone
subroutine amg_d_inner_clone(prec,precout,info)
implicit none
class(amg_dprec_type), intent(inout) :: prec
class(psb_dprec_type), target, intent(inout) :: precout
@@ -929,8 +935,9 @@ contains
pout%ctxt = prec%ctxt
pout%ag_data = prec%ag_data
pout%outer_sweeps = prec%outer_sweeps
pout%nlevs = prec%nlevs
if (allocated(prec%precv)) then
ln = size(prec%precv)
ln = prec%get_nlevs()
allocate(pout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln >= 1) then
@@ -938,6 +945,7 @@ contains
end if
do lev=2, ln
if (info /= psb_success_) exit
!!$ write(0,*) 'Inner_clone must be checked and reimplemented! '
call prec%precv(lev)%clone(pout%precv(lev),info)
if (info == psb_success_) then
pout%precv(lev)%base_a => pout%precv(lev)%ac
@@ -1002,7 +1010,7 @@ contains
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type), intent(in), optional :: vmold
!
! In MLD the DESC optional argument is ignored, since
! In AMG the DESC optional argument is ignored, since
! the necessary info is contained in the various entries of the
! PRECV component.
type(psb_desc_type), intent(in), optional :: desc
@@ -1017,7 +1025,7 @@ contains
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
nlev = size(prec%precv)
nlev = prec%get_nlevs()
level = 1
do level = 1, nlev
call prec%precv(level)%allocate_wrk(info,vmold=vmold)
@@ -1040,7 +1048,6 @@ contains
subroutine amg_d_free_wrk(prec,info)
use psb_base_mod
implicit none
! Arguments
class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -1057,7 +1064,7 @@ contains
end if
if (allocated(prec%precv)) then
nlev = size(prec%precv)
nlev = prec%get_nlevs()
do level = 1, nlev
call prec%precv(level)%free_wrk(info)
end do
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -124,7 +124,7 @@ module amg_d_slu_solver
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_slu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -259,7 +259,7 @@ contains
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_sludist_solver_type), intent(inout) :: sv
integer, intent(out) :: info
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -163,7 +163,7 @@ module amg_d_umf_solver
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_d_umf_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+3 -3
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -103,7 +103,7 @@ module amg_s_ainv_solver
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@@ -225,7 +225,7 @@ module amg_s_ainv_solver
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_d_vect_type, psb_s_base_vect_type, psb_spk_, psb_ipk_
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
integer(psb_ipk_), intent(in) :: fillin,alg
real(psb_spk_), intent(in) :: thresh
type(psb_sspmat_type), intent(inout) :: wmat, zmat
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution.
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -230,7 +230,7 @@ module amg_s_as_smoother
& psb_desc_type, psb_s_base_sparse_mat, psb_ipk_,&
& psb_i_base_vect_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
+6 -7
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -89,7 +89,7 @@ module amg_s_base_aggregator_mod
procedure, pass(ag) :: bld_tprol => amg_s_base_aggregator_build_tprol
procedure, pass(ag) :: mat_bld => amg_s_base_aggregator_mat_bld
procedure, pass(ag) :: mat_asb => amg_s_base_aggregator_mat_asb
procedure, pass(ag) :: bld_map => amg_s_base_aggregator_bld_map
procedure, pass(ag) :: bld_linmap => amg_s_base_aggregator_bld_linmap
procedure, pass(ag) :: update_next => amg_s_base_aggregator_update_next
procedure, pass(ag) :: clone => amg_s_base_aggregator_clone
procedure, pass(ag) :: free => amg_s_base_aggregator_free
@@ -458,7 +458,7 @@ contains
end subroutine amg_s_base_aggregator_mat_asb
!
!> Function bld_map
!> Function bld_linmap
!! \memberof amg_s_base_aggregator_type
!! \brief Build linear map between hierarchy levels
!!
@@ -473,7 +473,7 @@ contains
!! \param map The output map
!! \param info Return code
!!
subroutine amg_s_base_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
subroutine amg_s_base_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
& op_restr,op_prol,map,info)
use psb_base_mod
implicit none
@@ -484,7 +484,7 @@ contains
type(psb_slinmap_type), intent(out) :: map
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_base_aggregator_bld_map'
character(len=20) :: name='s_base_aggregator_bld_linmap'
info = psb_success_
call psb_erractionsave(err_act)
@@ -508,7 +508,6 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine amg_s_base_aggregator_bld_map
end subroutine amg_s_base_aggregator_bld_linmap
end module amg_s_base_aggregator_mod
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -237,7 +237,7 @@ module amg_s_base_smoother_mod
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_base_smoother_type, psb_ipk_, psb_i_base_vect_type
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_base_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -170,7 +170,7 @@ module amg_s_base_solver_mod
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_base_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+3 -3
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -119,7 +119,7 @@ module amg_s_diag_solver
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@@ -331,7 +331,7 @@ module amg_s_l1_diag_solver
import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, &
& psb_s_vect_type, psb_s_base_vect_type, psb_spk_, &
& amg_s_l1_diag_solver_type, psb_ipk_, psb_i_base_vect_type
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_l1_diag_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -181,7 +181,7 @@ module amg_s_gs_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_gs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@@ -195,7 +195,7 @@ module amg_s_gs_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_bwgs_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -123,7 +123,7 @@ contains
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_id_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -144,7 +144,7 @@ module amg_s_ilu_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_ilu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+4 -4
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -56,7 +56,7 @@ module amg_s_inner_mod
& psb_spk_, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
import :: amg_sprec_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(amg_sprec_type), intent(inout), target :: prec
integer(psb_ipk_), intent(out) :: info
@@ -67,7 +67,7 @@ module amg_s_inner_mod
end interface amg_mlprec_bld
interface amg_mlprec_aply
subroutine amg_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
subroutine amg_smlprec_aply_a(alpha,p,x,beta,y,desc_data,trans,work,info)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
import :: amg_sprec_type
implicit none
@@ -79,7 +79,7 @@ module amg_s_inner_mod
character,intent(in) :: trans
real(psb_spk_),target :: work(:)
integer(psb_ipk_), intent(out) :: info
end subroutine amg_smlprec_aply
end subroutine amg_smlprec_aply_a
subroutine amg_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
import :: psb_sspmat_type, psb_desc_type, &
& psb_spk_, psb_s_vect_type, psb_ipk_
+2 -2
View File
@@ -20,7 +20,7 @@
! documentation and/or other materials provided with the distribution.
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -94,7 +94,7 @@ module amg_s_invk_solver
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_invk_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -94,7 +94,7 @@ module amg_s_invt_solver
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_invt_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -151,7 +151,7 @@ module amg_s_jac_smoother
import :: psb_desc_type, amg_s_jac_smoother_type, psb_s_vect_type, psb_spk_, &
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
@@ -274,7 +274,7 @@ module amg_s_jac_smoother
import :: psb_desc_type, amg_s_l1_jac_smoother_type, psb_s_vect_type, &
& 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_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_l1_jac_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -143,7 +143,7 @@ module amg_s_jac_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@@ -160,7 +160,7 @@ module amg_s_jac_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_l1_jac_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+3 -3
View File
@@ -23,7 +23,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -57,7 +57,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -174,7 +174,7 @@ module amg_s_krm_solver
& psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
& psb_ipk_, psb_i_base_vect_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_krm_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -54,7 +54,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+2 -2
View File
@@ -21,7 +21,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -163,7 +163,7 @@ module amg_s_mumps_solver
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_mumps_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+161 -376
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -155,13 +155,35 @@ module amg_s_onelev_mod
private :: s_wrk_alloc, s_wrk_free, &
& s_wrk_clone, s_wrk_move_alloc, s_wrk_cnv, s_wrk_sizeof
!
! Remap.
! This keeps track of remapping.
! Logic here is as follows:
! 1. AC_PRE_REMAP need to figure out if we
! really need it.
! 2. DESC_AC_PRE_REMAP contains the descriptor before
! remapping. Meaning that it is possible
! to implement the RESTRICTOR operator by
! a. Doing LINMAP_U2V onto this one
! b. For each process, send the data to
! IDEST.
! This assumes that remapping goes by
! a factor of 2.
! For the PROLONGATOR operators, we first
! use DESC_AC, then split and send onto
! the processes in DESC_AC_PRE_REMAP.
!
! To be fixed: what happens if NP the starting processes
! is not an even number? Coordinate with _X_remap in PSBLAS
!
type amg_s_remap_data_type
type(psb_sspmat_type) :: ac_pre_remap
type(psb_desc_type) :: desc_ac_pre_remap
integer(psb_ipk_) :: idest
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:), naggr(:)
contains
procedure, pass(rmp) :: clone => s_remap_data_clone
procedure, pass(rmp) :: clone => s_remap_data_clone
procedure, pass(rmp) :: move_alloc => s_remap_move_alloc
end type amg_s_remap_data_type
type amg_s_onelev_type
@@ -207,7 +229,7 @@ module amg_s_onelev_mod
procedure, pass(lv) :: get_wrksz => s_base_onelev_get_wrksize
procedure, pass(lv) :: allocate_wrk => s_base_onelev_allocate_wrk
procedure, pass(lv) :: free_wrk => s_base_onelev_free_wrk
procedure, nopass :: stringval => amg_stringval
procedure, nopass :: stringval => amg_stringval
procedure, pass(lv) :: move_alloc => s_base_onelev_move_alloc
@@ -231,9 +253,7 @@ module amg_s_onelev_mod
& s_base_onelev_free_wrk
interface
subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_, psb_lsspmat_type, psb_lpk_
import :: amg_s_onelev_type
module subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
implicit none
class(amg_s_onelev_type), intent(inout), target :: lv
type(psb_sspmat_type), intent(in) :: a
@@ -245,10 +265,7 @@ module amg_s_onelev_mod
end interface
interface
subroutine amg_s_base_onelev_build(lv,info,amold,vmold,imold,ilv)
import :: psb_s_base_sparse_mat, psb_s_base_vect_type, &
& psb_i_base_vect_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_s_base_onelev_build(lv,info,amold,vmold,imold,ilv)
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
@@ -260,10 +277,7 @@ module amg_s_onelev_mod
end interface
interface
subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout, verbosity,prefix)
Implicit None
! Arguments
class(amg_s_onelev_type), intent(in) :: lv
@@ -276,10 +290,8 @@ module amg_s_onelev_mod
end interface
interface
subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,iout,verbosity, prefix,global)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_s_base_onelev_memory_use(lv,il,nl,ilmin,info,&
& iout,verbosity, prefix,global)
Implicit None
! Arguments
class(amg_s_onelev_type), intent(in) :: lv
@@ -293,10 +305,7 @@ module amg_s_onelev_mod
end interface
interface
subroutine amg_s_base_onelev_cnv(lv,info,amold,vmold,imold)
import :: amg_s_onelev_type, psb_s_base_vect_type, psb_spk_, &
& psb_s_base_sparse_mat, psb_ipk_, psb_i_base_vect_type
! Arguments
module subroutine amg_s_base_onelev_cnv(lv,info,amold,vmold,imold)
class(amg_s_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold
@@ -306,48 +315,32 @@ module amg_s_onelev_mod
end interface
interface
subroutine amg_s_base_onelev_free(lv,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_s_base_onelev_free(lv,info)
implicit none
class(amg_s_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_base_onelev_free
end interface
interface
subroutine amg_s_base_onelev_free_smoothers(lv,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_s_base_onelev_free_smoothers(lv,info)
implicit none
class(amg_s_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_base_onelev_free_smoothers
end interface
interface
subroutine amg_s_base_onelev_check(lv,info)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_s_base_onelev_check(lv,info)
Implicit None
! Arguments
class(amg_s_onelev_type), intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine amg_s_base_onelev_check
end interface
interface
subroutine amg_s_base_onelev_setsm(lv,val,info,pos)
import :: psb_spk_, amg_s_onelev_type, amg_s_base_smoother_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_s_base_onelev_setsm(lv,val,info,pos)
Implicit None
! Arguments
class(amg_s_onelev_type), target, intent(inout) :: lv
class(amg_s_base_smoother_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
@@ -356,12 +349,8 @@ module amg_s_onelev_mod
end interface
interface
subroutine amg_s_base_onelev_setsv(lv,val,info,pos)
import :: psb_spk_, amg_s_onelev_type, amg_s_base_solver_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_s_base_onelev_setsv(lv,val,info,pos)
Implicit None
! Arguments
class(amg_s_onelev_type), target, intent(inout) :: lv
class(amg_s_base_solver_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
@@ -370,12 +359,8 @@ module amg_s_onelev_mod
end interface
interface
subroutine amg_s_base_onelev_setag(lv,val,info,pos)
import :: psb_spk_, amg_s_onelev_type, amg_s_base_aggregator_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_s_base_onelev_setag(lv,val,info,pos)
Implicit None
! Arguments
class(amg_s_onelev_type), target, intent(inout) :: lv
class(amg_s_base_aggregator_type), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
@@ -384,13 +369,8 @@ module amg_s_onelev_mod
end interface
interface
subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_s_base_onelev_cseti(lv,what,val,info,pos,idx)
Implicit None
! Arguments
class(amg_s_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
@@ -401,12 +381,8 @@ module amg_s_onelev_mod
end interface
interface
subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
Implicit None
! Arguments
class(amg_s_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
@@ -417,12 +393,8 @@ module amg_s_onelev_mod
end interface
interface
subroutine amg_s_base_onelev_csetr(lv,what,val,info,pos,idx)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
module subroutine amg_s_base_onelev_csetr(lv,what,val,info,pos,idx)
Implicit None
class(amg_s_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
@@ -433,11 +405,8 @@ module amg_s_onelev_mod
end interface
interface
subroutine amg_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
module subroutine amg_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,&
& solver,tprol,global_num)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, amg_s_onelev_type, &
& psb_ipk_, psb_epk_, psb_desc_type
implicit none
class(amg_s_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: level
@@ -448,8 +417,7 @@ module amg_s_onelev_mod
end interface
interface
subroutine amg_s_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
import
module subroutine amg_s_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
real(psb_spk_), intent(in) :: alpha, beta
@@ -458,8 +426,8 @@ module amg_s_onelev_mod
integer(psb_ipk_), intent(out) :: info
real(psb_spk_), optional :: work(:)
end subroutine amg_s_base_onelev_map_rstr_a
subroutine amg_s_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
import
module subroutine amg_s_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
& work,vtx,vty)
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
real(psb_spk_), intent(in) :: alpha, beta
@@ -471,8 +439,7 @@ module amg_s_onelev_mod
end interface
interface
subroutine amg_s_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
import
module subroutine amg_s_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
real(psb_spk_), intent(in) :: alpha, beta
@@ -482,8 +449,8 @@ module amg_s_onelev_mod
real(psb_spk_), optional :: work(:)
end subroutine amg_s_base_onelev_map_prol_a
subroutine amg_s_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
import
module subroutine amg_s_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,&
& work,vtx,vty)
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
real(psb_spk_), intent(in) :: alpha, beta
@@ -494,6 +461,118 @@ module amg_s_onelev_mod
end subroutine amg_s_base_onelev_map_prol_v
end interface
interface
module subroutine s_base_onelev_move_alloc(lv, b,info)
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv, b
integer(psb_ipk_), intent(out) :: info
end subroutine s_base_onelev_move_alloc
end interface
interface
module subroutine s_base_onelev_allocate_wrk(lv,info,vmold)
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: vmold
end subroutine s_base_onelev_allocate_wrk
end interface
interface
module subroutine s_base_onelev_free_wrk(lv,info)
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
end subroutine s_base_onelev_free_wrk
end interface
interface
module subroutine s_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
Implicit None
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: vmold
type(psb_desc_type), intent(in), optional :: desc2
end subroutine s_wrk_alloc
end interface
interface
module subroutine s_inner_do_wrk_alloc(wk,nwv,desc,vmold)
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
class(psb_s_base_vect_type), intent(in), optional :: vmold
end subroutine s_inner_do_wrk_alloc
end interface
interface
module subroutine s_wrk_free(wk,info)
Implicit None
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
end subroutine s_wrk_free
end interface
interface
module subroutine s_wrk_clone(wk,wkout,info)
Implicit None
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
class(amg_smlprec_wrk_type), target, intent(inout) :: wkout
integer(psb_ipk_), intent(out) :: info
end subroutine s_wrk_clone
end interface
interface
module subroutine s_wrk_move_alloc(wk, b,info)
implicit none
class(amg_smlprec_wrk_type), target, intent(inout) :: wk, b
integer(psb_ipk_), intent(out) :: info
end subroutine s_wrk_move_alloc
end interface
interface
module subroutine s_wrk_cnv(wk,info,vmold)
Implicit None
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: vmold
end subroutine s_wrk_cnv
end interface
interface
module function s_wrk_sizeof(wk) result(val)
implicit none
class(amg_smlprec_wrk_type), intent(in) :: wk
integer(psb_epk_) :: val
end function s_wrk_sizeof
end interface
interface
module subroutine s_remap_data_clone(rmp, remap_out, info)
implicit none
! Arguments
class(amg_s_remap_data_type), target, intent(inout) :: rmp
class(amg_s_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
end subroutine s_remap_data_clone
end interface
interface
module subroutine s_remap_move_alloc(rmp, remap_out, info)
implicit none
! Arguments
class(amg_s_remap_data_type), target, intent(inout) :: rmp
class(amg_s_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
end subroutine s_remap_move_alloc
end interface
contains
!
! Function returning the size of the amg_prec_type data structure
@@ -619,7 +698,7 @@ contains
! Arguments
class(amg_s_onelev_type), target, intent(inout) :: lv
class(amg_s_onelev_type), target, intent(inout) :: lvout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (allocated(lv%sm)) then
@@ -661,36 +740,6 @@ contains
end subroutine s_base_onelev_clone
subroutine s_base_onelev_move_alloc(lv, b,info)
use psb_base_mod
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv, b
integer(psb_ipk_), intent(out) :: info
call b%free(info)
b%parms = lv%parms
b%szratio = lv%szratio
if (associated(lv%sm2,lv%sm2a)) then
call move_alloc(lv%sm,b%sm)
call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm2a
else
call move_alloc(lv%sm,b%sm)
call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm
end if
call move_alloc(lv%aggr,b%aggr)
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
b%base_a => lv%base_a
b%base_desc => lv%base_desc
end subroutine s_base_onelev_move_alloc
function s_base_onelev_get_wrksize(lv) result(val)
implicit none
class(amg_s_onelev_type), intent(inout) :: lv
@@ -728,269 +777,5 @@ contains
end function s_base_onelev_get_wrksize
subroutine s_base_onelev_allocate_wrk(lv,info,vmold)
use psb_base_mod
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: nwv, i
info = psb_success_
nwv = lv%get_wrksz()
if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
if (info == 0) then
if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
!
! Need to fix this, we need two different allocations
!
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold,&
& desc2=lv%remap_data%desc_ac_pre_remap)
else
call lv%wrk%alloc(nwv,lv%base_desc,info,vmold=vmold)
end if
end if
end subroutine s_base_onelev_allocate_wrk
subroutine s_base_onelev_free_wrk(lv,info)
use psb_base_mod
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: nwv,i
info = psb_success_
if (allocated(lv%wrk)) then
call lv%wrk%free(info)
if (info == 0) deallocate(lv%wrk,stat=info)
end if
end subroutine s_base_onelev_free_wrk
subroutine s_wrk_alloc(wk,nwv,desc,info,vmold, desc2)
use psb_base_mod
Implicit None
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(in) :: nwv
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: vmold
type(psb_desc_type), intent(in), optional :: desc2
!
integer(psb_ipk_) :: i
info = psb_success_
call wk%free(info)
if (present(desc2)) then
!!$ write(0,*) 'Check on wrk_alloc 2',&
!!$ & desc2%get_local_rows(), desc%get_local_rows(),&
!!$ & desc2%get_local_cols(),desc%get_local_cols()
!!$ flush(0)
if (desc2%get_local_cols()>desc%get_local_cols()) then
call psb_geasb(wk%vx2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc2,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc2,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc2,info,&
& scratch=.true.,mold=vmold)
end do
else
!!$ write(0,*) 'Check on wrk_alloc 1.5 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
else
!!$ write(0,*) 'Check on wrk_alloc 1 ',&
!!$ & desc%get_local_rows(),&
!!$ & desc%get_local_cols()
call psb_geasb(wk%vx2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vy2l,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vtx,desc,info,&
& scratch=.true.,mold=vmold)
call psb_geasb(wk%vty,desc,info,&
& scratch=.true.,mold=vmold)
allocate(wk%wv(nwv),stat=info)
do i=1,nwv
call psb_geasb(wk%wv(i),desc,info,&
& scratch=.true.,mold=vmold)
end do
end if
end subroutine s_wrk_alloc
subroutine s_wrk_free(wk,info)
Implicit None
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
if (allocated(wk%tx)) deallocate(wk%tx, stat=info)
if (allocated(wk%ty)) deallocate(wk%ty, stat=info)
if (allocated(wk%x2l)) deallocate(wk%x2l, stat=info)
if (allocated(wk%y2l)) deallocate(wk%y2l, stat=info)
call wk%vtx%free(info)
call wk%vty%free(info)
call wk%vx2l%free(info)
call wk%vy2l%free(info)
if (allocated(wk%wv)) then
do i=1,size(wk%wv)
call wk%wv(i)%free(info)
end do
deallocate(wk%wv, stat=info)
end if
end subroutine s_wrk_free
subroutine s_wrk_clone(wk,wkout,info)
use psb_base_mod
Implicit None
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
class(amg_smlprec_wrk_type), target, intent(inout) :: wkout
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call psb_safe_ab_cpy(wk%tx,wkout%tx,info)
call psb_safe_ab_cpy(wk%ty,wkout%ty,info)
call psb_safe_ab_cpy(wk%x2l,wkout%x2l,info)
call psb_safe_ab_cpy(wk%y2l,wkout%y2l,info)
call wk%vtx%clone(wkout%vtx,info)
call wk%vty%clone(wkout%vty,info)
call wk%vx2l%clone(wkout%vx2l,info)
call wk%vy2l%clone(wkout%vy2l,info)
if (allocated(wkout%wv)) then
do i=1,size(wkout%wv)
call wkout%wv(i)%free(info)
end do
deallocate( wkout%wv)
end if
allocate(wkout%wv(size(wk%wv)),stat=info)
do i=1,size(wk%wv)
call wk%wv(i)%clone(wkout%wv(i),info)
end do
return
end subroutine s_wrk_clone
subroutine s_wrk_move_alloc(wk, b,info)
implicit none
class(amg_smlprec_wrk_type), target, intent(inout) :: wk, b
integer(psb_ipk_), intent(out) :: info
call b%free(info)
call move_alloc(wk%tx,b%tx)
call move_alloc(wk%ty,b%ty)
call move_alloc(wk%x2l,b%x2l)
call move_alloc(wk%y2l,b%y2l)
!
! Should define V%move_alloc....
call move_alloc(wk%vtx%v,b%vtx%v)
call move_alloc(wk%vty%v,b%vty%v)
call move_alloc(wk%vx2l%v,b%vx2l%v)
call move_alloc(wk%vy2l%v,b%vy2l%v)
call move_alloc(wk%wv,b%wv)
end subroutine s_wrk_move_alloc
subroutine s_wrk_cnv(wk,info,vmold)
use psb_base_mod
Implicit None
! Arguments
class(amg_smlprec_wrk_type), target, intent(inout) :: wk
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: vmold
!
integer(psb_ipk_) :: i
info = psb_success_
if (present(vmold)) then
call wk%vtx%cnv(vmold)
call wk%vty%cnv(vmold)
call wk%vx2l%cnv(vmold)
call wk%vy2l%cnv(vmold)
if (allocated(wk%wv)) then
do i=1,size(wk%wv)
call wk%wv(i)%cnv(vmold)
end do
end if
end if
end subroutine s_wrk_cnv
function s_wrk_sizeof(wk) result(val)
use psb_realloc_mod
implicit none
class(amg_smlprec_wrk_type), intent(in) :: wk
integer(psb_epk_) :: val
integer :: i
val = 0
val = val + (1_psb_epk_ * psb_sizeof_sp) * psb_size(wk%tx)
val = val + (1_psb_epk_ * psb_sizeof_sp) * psb_size(wk%ty)
val = val + (1_psb_epk_ * psb_sizeof_sp) * psb_size(wk%x2l)
val = val + (1_psb_epk_ * psb_sizeof_sp) * psb_size(wk%y2l)
val = val + wk%vtx%sizeof()
val = val + wk%vty%sizeof()
val = val + wk%vx2l%sizeof()
val = val + wk%vy2l%sizeof()
if (allocated(wk%wv)) then
do i=1, size(wk%wv)
val = val + wk%wv(i)%sizeof()
end do
end if
end function s_wrk_sizeof
subroutine s_remap_data_clone(rmp, remap_out, info)
use psb_base_mod
implicit none
! Arguments
class(amg_s_remap_data_type), target, intent(inout) :: rmp
class(amg_s_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
if (info == psb_success_) &
& call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
remap_out%idest = rmp%idest
call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
end subroutine s_remap_data_clone
end module amg_s_onelev_mod
+6 -6
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -54,7 +54,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -136,7 +136,7 @@ module amg_s_parmatch_aggregator_mod
procedure, pass(ag) :: mat_bld => amg_s_parmatch_aggregator_mat_bld
procedure, pass(ag) :: mat_asb => amg_s_parmatch_aggregator_mat_asb
procedure, pass(ag) :: inner_mat_asb => amg_s_parmatch_aggregator_inner_mat_asb
procedure, pass(ag) :: bld_map => amg_s_parmatch_aggregator_bld_map
procedure, pass(ag) :: bld_linmap => amg_s_parmatch_aggregator_bld_linmap
procedure, pass(ag) :: csetc => amg_s_parmatch_aggr_csetc
procedure, pass(ag) :: cseti => amg_s_parmatch_aggr_cseti
procedure, pass(ag) :: default => amg_s_parmatch_aggr_set_default
@@ -643,7 +643,7 @@ contains
end select
end subroutine amg_s_parmatch_aggregator_clone
subroutine amg_s_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
subroutine amg_s_parmatch_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
& op_restr,op_prol,map,info)
use psb_base_mod
implicit none
@@ -654,7 +654,7 @@ contains
type(psb_slinmap_type), intent(out) :: map
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_parmatch_aggregator_bld_map'
character(len=20) :: name='s_parmatch_aggregator_bld_linmap'
info = psb_success_
call psb_erractionsave(err_act)
@@ -680,5 +680,5 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine amg_s_parmatch_aggregator_bld_map
end subroutine amg_s_parmatch_aggregator_bld_linmap
end module amg_s_parmatch_aggregator_mod
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -140,7 +140,7 @@ module amg_s_poly_smoother
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_sspmat_type), intent(inout), 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
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+47 -40
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -102,6 +102,7 @@ module amg_s_prec_type
! The multilevel hierarchy
!
type(amg_s_onelev_type), allocatable :: precv(:)
integer(psb_ipk_) :: nlevs
contains
procedure, pass(prec) :: psb_s_apply2_vect => amg_s_apply2_vect
procedure, pass(prec) :: psb_s_apply1_vect => amg_s_apply1_vect
@@ -119,6 +120,7 @@ module amg_s_prec_type
procedure, pass(prec) :: cmp_complexity => amg_s_cmp_compl
procedure, pass(prec) :: get_avg_cr => amg_s_get_avg_cr
procedure, pass(prec) :: cmp_avg_cr => amg_s_cmp_avg_cr
procedure, pass(prec) :: set_nlevs => amg_s_set_nlevs
procedure, pass(prec) :: get_nlevs => amg_s_get_nlevs
procedure, pass(prec) :: get_nzeros => amg_s_get_nzeros
procedure, pass(prec) :: sizeof => amg_sprec_sizeof
@@ -311,7 +313,7 @@ module amg_s_prec_type
& psb_s_base_sparse_mat, psb_s_base_vect_type, &
& psb_i_base_vect_type, amg_sprec_type, psb_ipk_
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
class(amg_sprec_type), intent(inout), target :: prec
integer(psb_ipk_), intent(out) :: info
@@ -323,14 +325,15 @@ module amg_s_prec_type
end interface amg_precbld
interface amg_hierarchy_bld
subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, &
& amg_sprec_type, psb_ipk_
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
class(amg_sprec_type), intent(inout), target :: prec
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: cpymat
! character, intent(in),optional :: upd
end subroutine amg_s_hierarchy_bld
end interface amg_hierarchy_bld
@@ -434,10 +437,19 @@ contains
class(amg_sprec_type), intent(in) :: prec
integer(psb_ipk_) :: val
val = 0
if (allocated(prec%precv)) then
val = size(prec%precv)
end if
!!$ if (allocated(prec%precv)) then
!!$ val = size(prec%precv)
!!$ end if
val = prec%nlevs
!!$ write(0,*) ' NLEVS: ',prec%nlevs, val,size(prec%precv)
end function amg_s_get_nlevs
subroutine amg_s_set_nlevs(prec,nl)
implicit none
class(amg_sprec_type), intent(inout) :: prec
integer(psb_ipk_) :: nl
prec%nlevs = nl
end subroutine amg_s_set_nlevs
!
! Function returning the size of the amg_prec_type data structure
! in bytes or in number of nonzeros of the operator(s) involved.
@@ -508,7 +520,7 @@ contains
real(psb_spk_) :: num, den, nmin
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il
integer(psb_ipk_) :: il,nl
num = -sone
den = sone
@@ -518,7 +530,10 @@ contains
num = prec%precv(il)%base_a%get_nzeros()
if (num >= szero) then
den = num
do il=2,size(prec%precv)
nl = prec%get_nlevs()
!!$ write(0,*) 'Inside cmp_compl ',nl,size(prec%precv)
do il=2, nl
!!$ write(0,*) ' ',il,associated(prec%precv(il)%base_a)
num = num + max(0,prec%precv(il)%base_a%get_nzeros())
end do
end if
@@ -549,7 +564,6 @@ contains
end function amg_s_get_avg_cr
subroutine amg_s_cmp_avg_cr(prec)
implicit none
class(amg_sprec_type), intent(inout) :: prec
@@ -557,17 +571,18 @@ contains
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: il, nl, iam, np
avgcr = szero
nl = prec%get_nlevs()
do il=2,nl
if (prec%precv(il)%base_desc%is_ok()) then
ctxt = prec%precv(il)%base_desc%get_ctxt()
call psb_info(ctxt,iam,np)
if (iam >=0) avgcr = avgcr + max(szero,prec%precv(il)%szratio)
end if
end do
avgcr = avgcr / (nl-1)
ctxt = prec%ctxt
call psb_info(ctxt,iam,np)
if (allocated(prec%precv)) then
nl = size(prec%precv)
do il=2,nl
avgcr = avgcr + max(szero,prec%precv(il)%szratio)
end do
avgcr = avgcr / (nl-1)
end if
call psb_sum(ctxt,avgcr)
prec%ag_data%avg_cr = avgcr/np
end subroutine amg_s_cmp_avg_cr
@@ -585,9 +600,7 @@ contains
! error code.
!
subroutine amg_sprecfree(p,info)
implicit none
! Arguments
type(amg_sprec_type), intent(inout) :: p
integer(psb_ipk_), intent(out) :: info
@@ -613,9 +626,7 @@ contains
end subroutine amg_sprecfree
subroutine amg_s_prec_free(prec,info)
implicit none
! Arguments
class(amg_sprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -635,6 +646,11 @@ contains
if (allocated(prec%precv)) then
do i=1,size(prec%precv)
call prec%precv(i)%free(info)
if (psb_errstatus_fatal()) then
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
end do
deallocate(prec%precv,stat=info)
end if
@@ -647,9 +663,7 @@ contains
end subroutine amg_s_prec_free
subroutine amg_s_smoothers_free(prec,info)
implicit none
! Arguments
class(amg_sprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -666,7 +680,7 @@ contains
end if
if (allocated(prec%precv)) then
do i=1,size(prec%precv)
do i=1,prec%get_nlevs()
call prec%precv(i)%free_smoothers(info)
end do
end if
@@ -680,9 +694,7 @@ contains
end subroutine amg_s_smoothers_free
subroutine amg_s_hierarchy_free(prec,info)
implicit none
! Arguments
class(amg_sprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -709,7 +721,6 @@ contains
end subroutine amg_s_hierarchy_free
!
! Top level methods.
!
@@ -774,7 +785,6 @@ contains
end subroutine amg_s_apply1_vect
subroutine amg_s_apply2v(prec,x,y,desc_data,info,trans,work)
implicit none
type(psb_desc_type),intent(in) :: desc_data
@@ -839,7 +849,6 @@ contains
subroutine amg_s_dump(prec,info,istart,iend,iproc,prefix,head,&
& ac,rp,smoother,solver,tprol,&
& global_num)
implicit none
class(amg_sprec_type), intent(in) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -856,7 +865,7 @@ contains
info = 0
ctxt = prec%ctxt
call psb_info(ctxt,iam,np)
iln = size(prec%precv)
iln = prec%get_nlevs()
if (present(istart)) then
il1 = max(1,istart)
else
@@ -880,7 +889,6 @@ contains
end subroutine amg_s_dump
subroutine amg_s_cnv(prec,info,amold,vmold,imold)
implicit none
class(amg_sprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -892,7 +900,7 @@ contains
info = psb_success_
if (allocated(prec%precv)) then
do i=1,size(prec%precv)
do i=1,prec%get_nlevs()
if (info == psb_success_ ) &
& call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold)
end do
@@ -901,7 +909,6 @@ contains
end subroutine amg_s_cnv
subroutine amg_s_clone(prec,precout,info)
implicit none
class(amg_sprec_type), intent(inout) :: prec
class(psb_sprec_type), intent(inout) :: precout
@@ -913,7 +920,6 @@ contains
end subroutine amg_s_clone
subroutine amg_s_inner_clone(prec,precout,info)
implicit none
class(amg_sprec_type), intent(inout) :: prec
class(psb_sprec_type), target, intent(inout) :: precout
@@ -929,8 +935,9 @@ contains
pout%ctxt = prec%ctxt
pout%ag_data = prec%ag_data
pout%outer_sweeps = prec%outer_sweeps
pout%nlevs = prec%nlevs
if (allocated(prec%precv)) then
ln = size(prec%precv)
ln = prec%get_nlevs()
allocate(pout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln >= 1) then
@@ -938,6 +945,7 @@ contains
end if
do lev=2, ln
if (info /= psb_success_) exit
!!$ write(0,*) 'Inner_clone must be checked and reimplemented! '
call prec%precv(lev)%clone(pout%precv(lev),info)
if (info == psb_success_) then
pout%precv(lev)%base_a => pout%precv(lev)%ac
@@ -1002,7 +1010,7 @@ contains
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: vmold
!
! In MLD the DESC optional argument is ignored, since
! In AMG the DESC optional argument is ignored, since
! the necessary info is contained in the various entries of the
! PRECV component.
type(psb_desc_type), intent(in), optional :: desc
@@ -1017,7 +1025,7 @@ contains
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
nlev = size(prec%precv)
nlev = prec%get_nlevs()
level = 1
do level = 1, nlev
call prec%precv(level)%allocate_wrk(info,vmold=vmold)
@@ -1040,7 +1048,6 @@ contains
subroutine amg_s_free_wrk(prec,info)
use psb_base_mod
implicit none
! Arguments
class(amg_sprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -1057,7 +1064,7 @@ contains
end if
if (allocated(prec%precv)) then
nlev = size(prec%precv)
nlev = prec%get_nlevs()
do level = 1, nlev
call prec%precv(level)%free_wrk(info)
end do
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -124,7 +124,7 @@ module amg_s_slu_solver
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_s_slu_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+3 -3
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -103,7 +103,7 @@ module amg_z_ainv_solver
Implicit None
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_ainv_solver_type), intent(inout) :: sv
integer(psb_ipk_), intent(out) :: info
@@ -225,7 +225,7 @@ module amg_z_ainv_solver
import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, &
& psb_d_vect_type, psb_z_base_vect_type, psb_dpk_, psb_ipk_
implicit none
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
integer(psb_ipk_), intent(in) :: fillin,alg
real(psb_dpk_), intent(in) :: thresh
type(psb_zspmat_type), intent(inout) :: wmat, zmat
+2 -2
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -230,7 +230,7 @@ module amg_z_as_smoother
& psb_desc_type, psb_z_base_sparse_mat, psb_ipk_,&
& psb_i_base_vect_type
implicit none
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(inout), target :: a
Type(psb_desc_type), Intent(inout) :: desc_a
class(amg_z_as_smoother_type), intent(inout) :: sm
integer(psb_ipk_), intent(out) :: info
+6 -7
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -89,7 +89,7 @@ module amg_z_base_aggregator_mod
procedure, pass(ag) :: bld_tprol => amg_z_base_aggregator_build_tprol
procedure, pass(ag) :: mat_bld => amg_z_base_aggregator_mat_bld
procedure, pass(ag) :: mat_asb => amg_z_base_aggregator_mat_asb
procedure, pass(ag) :: bld_map => amg_z_base_aggregator_bld_map
procedure, pass(ag) :: bld_linmap => amg_z_base_aggregator_bld_linmap
procedure, pass(ag) :: update_next => amg_z_base_aggregator_update_next
procedure, pass(ag) :: clone => amg_z_base_aggregator_clone
procedure, pass(ag) :: free => amg_z_base_aggregator_free
@@ -458,7 +458,7 @@ contains
end subroutine amg_z_base_aggregator_mat_asb
!
!> Function bld_map
!> Function bld_linmap
!! \memberof amg_z_base_aggregator_type
!! \brief Build linear map between hierarchy levels
!!
@@ -473,7 +473,7 @@ contains
!! \param map The output map
!! \param info Return code
!!
subroutine amg_z_base_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
subroutine amg_z_base_aggregator_bld_linmap(ag,desc_a,desc_ac,ilaggr,nlaggr,&
& op_restr,op_prol,map,info)
use psb_base_mod
implicit none
@@ -484,7 +484,7 @@ contains
type(psb_zlinmap_type), intent(out) :: map
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_base_aggregator_bld_map'
character(len=20) :: name='z_base_aggregator_bld_linmap'
info = psb_success_
call psb_erractionsave(err_act)
@@ -508,7 +508,6 @@ contains
9999 call psb_error_handler(err_act)
return
end subroutine amg_z_base_aggregator_bld_map
end subroutine amg_z_base_aggregator_bld_linmap
end module amg_z_base_aggregator_mod
+1 -1
View File
@@ -20,7 +20,7 @@
! 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.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED

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