fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-24 14:51:49 +00:00
Code Issues Packages Projects Releases Wiki Activity

Updated PENV with min/max.

Browse Source 
Updated docs on utilities.
This commit is contained in:
Salvatore Filippone
2007-01-30 16:16:13 +00:00
parent 60bc82efc1
commit 8bc00d4083
11 changed files with 7034 additions and 4593 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/Makefile
+1 -1
View File
@@ -20,7 +20,7 @@ INCDIRS = -I .
psb_realloc_mod.o : psb_error_mod.o
psb_spmat_type.o : psb_realloc_mod.o psb_error_mod.o psb_const_mod.o psb_string_mod.o
psb_error_mod.o: psb_const_mod.o
psb_penv_mod.o: psb_const_mod.o psb_error_mod.o
psb_penv_mod.o: psb_const_mod.o psb_error_mod.o psb_realloc_mod.o
psi_mod.o: psb_penv_mod.o psb_error_mod.o psb_desc_type.o
psb_desc_type.o: psb_const_mod.o psb_error_mod.o psb_penv_mod.o
psb_check_mod.o: psb_desc_type.o
base/modules/psb_penv_mod.f90
+376 -1
View File
@@ -77,6 +77,17 @@ module psb_penv_mod
& psb_hrcvs, psb_lrcvs
end interface
interface psb_max
module procedure psb_imaxs, psb_imaxv, psb_imaxm,&
& psb_dmaxs, psb_dmaxv, psb_dmaxm
end interface
interface psb_min
module procedure psb_imins, psb_iminv, psb_iminm,&
& psb_dmins, psb_dminv, psb_dminm
end interface
interface psb_amx
module procedure psb_iamxs, psb_iamxv, psb_iamxm,&
@@ -96,7 +107,6 @@ module psb_penv_mod
& psb_zsums, psb_zsumv, psb_zsumm
end interface
interface gebs2d
module procedure igebs2ds, igebs2dv, igebs2dm,&
@@ -482,6 +492,371 @@ contains
end subroutine psb_lbcasts
subroutine psb_imaxs(ictxt,dat,root)
use mpi
integer, intent(in) :: ictxt
integer, intent(inout) :: dat
integer, intent(in), optional :: root
integer :: root_, dat_
integer :: iam, np, icomm
call psb_info(ictxt,iam,np)
call psb_get_mpicomm(ictxt,icomm)
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_integer,mpi_max,icomm)
dat = dat_
else
call mpi_reduce(dat,dat_,1,mpi_integer,mpi_max,root_,icomm)
dat = dat_
endif
end subroutine psb_imaxs
subroutine psb_imaxv(ictxt,dat,root)
use mpi
use psb_realloc_mod
integer, intent(in) :: ictxt
integer, intent(inout) :: dat(:)
integer, intent(in), optional :: root
integer :: root_
integer, allocatable :: dat_(:)
integer :: iam, np, icomm, info
call psb_info(ictxt,iam,np)
call psb_get_mpicomm(ictxt,icomm)
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
call psb_realloc(size(dat),dat_,info)
if (info ==0) call mpi_allreduce(dat_,dat,size(dat),mpi_integer,mpi_max,icomm)
else
if (iam==root_) then
call psb_realloc(size(dat),dat_,info)
call mpi_reduce(dat_,dat,size(dat),mpi_integer,mpi_max,root_,icomm)
else
call mpi_reduce(dat,dat_,size(dat),mpi_integer,mpi_max,root_,icomm)
end if
endif
end subroutine psb_imaxv
subroutine psb_imaxm(ictxt,dat,root)
use mpi
use psb_realloc_mod
integer, intent(in) :: ictxt
integer, intent(inout) :: dat(:,:)
integer, intent(in), optional :: root
integer :: root_
integer, allocatable :: dat_(:,:)
integer :: iam, np, icomm, info
call psb_info(ictxt,iam,np)
call psb_get_mpicomm(ictxt,icomm)
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,info)
if (info ==0) call mpi_allreduce(dat_,dat,size(dat),mpi_integer,mpi_max,icomm)
else
if (iam==root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,info)
call mpi_reduce(dat_,dat,size(dat),mpi_integer,mpi_max,root_,icomm)
else
call mpi_reduce(dat,dat_,size(dat),mpi_integer,mpi_max,root_,icomm)
end if
endif
end subroutine psb_imaxm
subroutine psb_dmaxs(ictxt,dat,root)
use mpi
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat
integer, intent(in), optional :: root
integer :: root_
real(kind(1.d0)) :: dat_
integer :: iam, np, icomm
call psb_info(ictxt,iam,np)
call psb_get_mpicomm(ictxt,icomm)
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_max,icomm)
dat = dat_
else
call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_max,root_,icomm)
dat = dat_
endif
end subroutine psb_dmaxs
subroutine psb_dmaxv(ictxt,dat,root)
use mpi
use psb_realloc_mod
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat(:)
integer, intent(in), optional :: root
integer :: root_
real(kind(1.d0)), allocatable :: dat_(:)
integer :: iam, np, icomm, info
call psb_info(ictxt,iam,np)
call psb_get_mpicomm(ictxt,icomm)
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
call psb_realloc(size(dat),dat_,info)
dat_ = dat
if (info ==0) call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_max,icomm)
else
if (iam==root_) then
call psb_realloc(size(dat),dat_,info)
dat_ = dat
call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_max,root_,icomm)
else
call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_max,root_,icomm)
end if
endif
end subroutine psb_dmaxv
subroutine psb_dmaxm(ictxt,dat,root)
use mpi
use psb_realloc_mod
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat(:,:)
integer, intent(in), optional :: root
integer :: root_
real(kind(1.d0)), allocatable :: dat_(:,:)
integer :: iam, np, icomm, info
call psb_info(ictxt,iam,np)
call psb_get_mpicomm(ictxt,icomm)
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,info)
dat_ = dat
if (info ==0) call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_max,icomm)
else
if (iam==root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,info)
dat_ = dat
call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_max,root_,icomm)
else
call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_max,root_,icomm)
end if
endif
end subroutine psb_dmaxm
subroutine psb_imins(ictxt,dat,root)
use mpi
integer, intent(in) :: ictxt
integer, intent(inout) :: dat
integer, intent(in), optional :: root
integer :: root_, dat_
integer :: iam, np, icomm
call psb_info(ictxt,iam,np)
call psb_get_mpicomm(ictxt,icomm)
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_integer,mpi_min,icomm)
dat = dat_
else
call mpi_reduce(dat,dat_,1,mpi_integer,mpi_min,root_,icomm)
dat = dat_
endif
end subroutine psb_imins
subroutine psb_iminv(ictxt,dat,root)
use mpi
use psb_realloc_mod
integer, intent(in) :: ictxt
integer, intent(inout) :: dat(:)
integer, intent(in), optional :: root
integer :: root_
integer, allocatable :: dat_(:)
integer :: iam, np, icomm, info
call psb_info(ictxt,iam,np)
call psb_get_mpicomm(ictxt,icomm)
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
call psb_realloc(size(dat),dat_,info)
if (info ==0) call mpi_allreduce(dat_,dat,size(dat),mpi_integer,mpi_min,icomm)
else
if (iam==root_) then
call psb_realloc(size(dat),dat_,info)
call mpi_reduce(dat_,dat,size(dat),mpi_integer,mpi_min,root_,icomm)
else
call mpi_reduce(dat,dat_,size(dat),mpi_integer,mpi_min,root_,icomm)
end if
endif
end subroutine psb_iminv
subroutine psb_iminm(ictxt,dat,root)
use mpi
use psb_realloc_mod
integer, intent(in) :: ictxt
integer, intent(inout) :: dat(:,:)
integer, intent(in), optional :: root
integer :: root_
integer, allocatable :: dat_(:,:)
integer :: iam, np, icomm, info
call psb_info(ictxt,iam,np)
call psb_get_mpicomm(ictxt,icomm)
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,info)
if (info ==0) call mpi_allreduce(dat_,dat,size(dat),mpi_integer,mpi_min,icomm)
else
if (iam==root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,info)
call mpi_reduce(dat_,dat,size(dat),mpi_integer,mpi_min,root_,icomm)
else
call mpi_reduce(dat,dat_,size(dat),mpi_integer,mpi_min,root_,icomm)
end if
endif
end subroutine psb_iminm
subroutine psb_dmins(ictxt,dat,root)
use mpi
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat
integer, intent(in), optional :: root
integer :: root_
real(kind(1.d0)) :: dat_
integer :: iam, np, icomm
call psb_info(ictxt,iam,np)
call psb_get_mpicomm(ictxt,icomm)
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_min,icomm)
dat = dat_
else
call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_min,root_,icomm)
dat = dat_
endif
end subroutine psb_dmins
subroutine psb_dminv(ictxt,dat,root)
use mpi
use psb_realloc_mod
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat(:)
integer, intent(in), optional :: root
integer :: root_
real(kind(1.d0)), allocatable :: dat_(:)
integer :: iam, np, icomm, info
call psb_info(ictxt,iam,np)
call psb_get_mpicomm(ictxt,icomm)
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
call psb_realloc(size(dat),dat_,info)
dat_ = dat
if (info ==0) call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_min,icomm)
else
if (iam==root_) then
call psb_realloc(size(dat),dat_,info)
dat_ = dat
call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_min,root_,icomm)
else
call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_min,root_,icomm)
end if
endif
end subroutine psb_dminv
subroutine psb_dminm(ictxt,dat,root)
use mpi
use psb_realloc_mod
integer, intent(in) :: ictxt
real(kind(1.d0)), intent(inout) :: dat(:,:)
integer, intent(in), optional :: root
integer :: root_
real(kind(1.d0)), allocatable :: dat_(:,:)
integer :: iam, np, icomm, info
call psb_info(ictxt,iam,np)
call psb_get_mpicomm(ictxt,icomm)
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,info)
dat_ = dat
if (info ==0) call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_min,icomm)
else
if (iam==root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,info)
dat_ = dat
call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_min,root_,icomm)
else
call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_min,root_,icomm)
end if
endif
end subroutine psb_dminm
subroutine psb_iamxs(ictxt,dat,root,ia)
integer, intent(in) :: ictxt
integer, intent(inout) :: dat
base/modules/psb_realloc_mod.F90
+12 -7
View File
@@ -75,8 +75,8 @@ Contains
use psb_error_mod
! ...Subroutine Arguments
Integer,allocatable,intent(in) :: vin(:)
Integer,allocatable,intent(out) :: vout(:)
Integer,allocatable, intent(in) :: vin(:)
Integer,allocatable, intent(out) :: vout(:)
integer :: info
! ...Local Variables
@@ -122,7 +122,8 @@ Contains
use psb_error_mod
! ...Subroutine Arguments
Integer,allocatable :: vin(:,:),vout(:,:)
Integer, allocatable, intent(in) :: vin(:,:)
Integer, allocatable, intent(out) :: vout(:,:)
integer :: info
! ...Local Variables
@@ -170,7 +171,8 @@ Contains
use psb_error_mod
! ...Subroutine Arguments
real(kind(1.d0)),allocatable :: vin(:),vout(:)
real(kind(1.d0)), allocatable, intent(in) :: vin(:)
real(kind(1.d0)), allocatable, intent(out) :: vout(:)
integer :: info
! ...Local Variables
@@ -216,7 +218,8 @@ Contains
use psb_error_mod
! ...Subroutine Arguments
real(kind(1.d0)),allocatable :: vin(:,:),vout(:,:)
real(kind(1.d0)), allocatable, intent(in) :: vin(:,:)
real(kind(1.d0)), allocatable, intent(out) :: vout(:,:)
integer :: info
! ...Local Variables
@@ -264,7 +267,8 @@ Contains
use psb_error_mod
! ...Subroutine Arguments
complex(kind(1.d0)),allocatable :: vin(:),vout(:)
complex(kind(1.d0)), allocatable, intent(in) :: vin(:)
complex(kind(1.d0)), allocatable, intent(out) :: vout(:)
integer :: info
! ...Local Variables
@@ -310,7 +314,8 @@ Contains
use psb_error_mod
! ...Subroutine Arguments
complex(kind(1.d0)),allocatable :: vin(:,:),vout(:,:)
complex(kind(1.d0)), allocatable, intent(in) :: vin(:,:)
complex(kind(1.d0)), allocatable, intent(out) :: vout(:,:)
integer :: info
! ...Local Variables
base/modules/psb_string_mod.f90
+5 -6
View File
@@ -30,6 +30,7 @@
!!$
module psb_string_mod
public tolower, toupper, touppers
interface tolower
module procedure tolowerc
end interface
@@ -42,13 +43,15 @@ module psb_string_mod
module procedure sub_toupperc
end interface
private
character(len=*), parameter :: lcase='abcdefghijklmnopqrstuvwxyz'
character(len=*), parameter :: ucase='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
contains
function tolowerc(string)
character(len=*), intent(in) :: string
character(len=len(string)) :: tolowerc
character(len=*), parameter :: lcase='abcdefghijklmnopqrstuvwxyz'
character(len=*), parameter :: ucase='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
integer :: i,k
do i=1,len(string)
@@ -64,8 +67,6 @@ contains
function toupperc(string)
character(len=*), intent(in) :: string
character(len=len(string)) :: toupperc
character(len=*), parameter :: lcase='abcdefghijklmnopqrstuvwxyz'
character(len=*), parameter :: ucase='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
integer :: i,k
do i=1,len(string)
@@ -81,8 +82,6 @@ contains
subroutine sub_toupperc(string,strout)
character(len=*), intent(in) :: string
character(len=*), intent(out) :: strout
character(len=*), parameter :: lcase='abcdefghijklmnopqrstuvwxyz'
character(len=*), parameter :: ucase='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
integer :: i,k
do i=1,len(string)