fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Created new routines for environment handling, modified documentation accordingly.

Browse Source
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent 045f80657f
commit b474f50151
142 changed files with 6552 additions and 5592 deletions
Show Stats Download Patch File Download Diff File

7
docs/pdf/datastruct.tex
Unescape Escape View File

@ -30,13 +30,14 @@ sparse matrix, however the definition of the descriptor is the
following.
\begin{description}
\item[{\bf matrix\_data}] includes general information about matrix and
BLACS grid. More precisely:
process grid. More precisely:
\begin{description}
\item[matrix\_data[psb\_dec\_type\_\hbox{]}] Identifies the decomposition type
(global); the actual values are internally defined, so they should
never be accessed directly.
\item[matrix\_data[psb\_ctxt\_\hbox{]}] Communication context as returned by the
BLACS (global).
\item[matrix\_data[psb\_ctxt\_\hbox{]}] Communication context
associated with the processes comprised in the virtual parallel
machine (global).
\item[matrix\_data[psb\_m\_\hbox{]}] Total number of equations (global).
\item[matrix\_data[psb\_n\_\hbox{]}] Total number of variables (global).
\item[matrix\_data[psb\_n\_row\_\hbox{]}] Number of grid variables owned by the

13
docs/pdf/intro.tex
Unescape Escape View File

@ -75,10 +75,10 @@ Message Passing Interface code is encapsulated within the BLACS
layer. However, in some cases, MPI routines are directly used either
to improve efficiency or to implement communication patterns for which
the BLACS package doesn't provide any method.
We assume that the user program has initialized a BLACS process grid
with one column and as many rows as there are processes; the PSBLAS
initialization routines will take the communication context for this
grid and store internally for further use.
%% We assume that the user program has initialized a BLACS process grid
%% with one column and as many rows as there are processes; the PSBLAS
%% initialization routines will take the communication context for this
%% grid and store internally for further use.
\begin{figure}[h] \begin{center}
\includegraphics[scale=0.45]{figures/psblas}
@ -101,6 +101,7 @@ systems solution for block diagonal matrices;
communications;
\item[Data management and auxiliary routines] including:
\begin{itemize}
\item Parallel environment management
\item Communication descriptors allocation;
\item Dense and sparse matrix allocation;
\item Dense and sparse matrix build and update;
@ -188,7 +189,7 @@ A simple application structure will walk through the index space
allocation, matrix/vector creation and linear system solution as
follows:
\begin{enumerate}
\item Initialize parallel environment with \verb|blacs_gridinit|
\item Initialize parallel environment with \verb|psb_init|
\item Initialize index space with \verb|psb_cdall|
\item Allocate sparse matrix and dense vectors with \verb|psb_spall|
and \verb|psb_geall|
@ -210,7 +211,7 @@ This is the structure of the sample program
For a simulation in which the same discretization mesh is used over
multiple time steps, the following structure may be more appropriate:
\begin{enumerate}
\item Initialize parallel environment with \verb|blacs_gridinit|
\item Initialize parallel environment with \verb|psb_init|
\item Initialize index space with \verb|psb_cdall|
\item Loop over the topology of the discretization mesh and build the
descriptor with \verb|psb_cdins|

118
docs/pdf/toolsrout.tex
Unescape Escape View File

@ -1,6 +1,122 @@
\section{Data management and initialization routines}
\section{Data management and environment handling routines}
\label{sec:toolsrout}
\subroutine{psb\_init}{Initializes PSBLAS parallel environment}
\syntax{call psb\_init}{ictxt, np}
This subroutine initializes the PSBLAS parallel environment, defining
a virtual parallel machine.
\begin{description}
\item[\bf On Entry ]
\item[np] Number of processes in the PSBLAS virtual parallel machine.\\
Scope:{\bf global}.\\
Type:{\bf optional}.\\
Specified as: an integer value. \
Default: use all available processes provided by the underlying
parallel environment.
\end{description}
\begin{description}
\item[\bf On Return]
\item[icontxt] the communication context identifying the virtual
parallel machine.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer variable.
\end{description}
\section*{Notes}
\begin{enumerate}
\item A call to this routine must precede any other PSBLAS call.
\item It is an error to specify a value for $np$ greater than the
number of processes available in the underlying parallel execution
environment.
\end{enumerate}
\subroutine{psb\_info}{Return information about PSBLAS parallel environment}
\syntax{call psb\_info}{ictxt, iam, np}
This subroutine returns informantion about the PSBLAS parallel environment, defining
a virtual parallel machine.
\begin{description}
\item[\bf On Entry ]
\item[icontxt] the communication context identifying the virtual
parallel machine.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer variable.
\end{description}
\begin{description}
\item[\bf On Return]
\item[iam] Identifier of current process in the PSBLAS virtual parallel machine.\\
Scope:{\bf local}.\\
Type:{\bf required}.\\
Specified as: an integer value. $-1 \le iam \le np-1$\
\item[np] Number of processes in the PSBLAS virtual parallel machine.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer variable. \
\end{description}
\section*{Notes}
\begin{enumerate}
\item For processes in the virtual parallel machine the identifier
will satisfy $0 \le iam \le np-1$;
\item If the user has requested on \verb|psb_init| a number of
processes less than the total available in the parallel execution
environment, the remaining processes will have on return $iam=-1$;
any such process may only place a call to \verb|psb_exit|, and is
required to do so.
\end{enumerate}
\subroutine{psb\_exit}{Exit from PSBLAS parallel environment}
\syntax{call psb\_exit}{ictxt}
This subroutine exits from the PSBLAS parallel virtual machine.
\begin{description}
\item[\bf On Entry ]
\item[icontxt] the communication context identifying the virtual
parallel machine.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer variable.
\end{description}
\section*{Notes}
\begin{enumerate}
\item This routine may be called even if a previous call to
\verb|psb_info| has returned with $iam=-1$; indeed, it it is the ONLY
routine that may be called in this situation, and it is required to
do so.
\end{enumerate}
\subroutine{psb\_barrier}{Sinchronization point parallel environment}
\syntax{call psb\_barrier}{ictxt}
This subroutine acts as a synchronization point for the PSBLAS
parallel virtual machine. As such, it must be called by all
participating processes.
\begin{description}
\item[\bf On Entry ]
\item[icontxt] the communication context identifying the virtual
parallel machine.\\
Scope:{\bf global}.\\
Type:{\bf required}.\\
Specified as: an integer variable.
\end{description}
%
%% psb_cdall %%

8098
docs/userguide.pdf
View File

File diff suppressed because one or more lines are too long

28
src/comm/psb_dgather.f90
Unescape Escape View File

@ -61,7 +61,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,&
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), root, iiroot, ilocx, iglobx, jlocx,&
& jglobx, lda_locx, lda_globx, m, lock, globk, maxk, k, jlx, ilx, i, j, idx
real(kind(1.d0)),pointer :: tmpx(:)
@ -72,10 +72,10 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,&
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -147,9 +147,9 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,&
end if
if (myrow == iiroot) then
call igebs2d(icontxt, 'all', ' ', 1, 1, k, 1)
call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1)
else
call igebr2d(icontxt, 'all', ' ', 1, 1, k, 1, iiroot, 0)
call igebr2d(ictxt, 'all', ' ', 1, 1, k, 1, iiroot, 0)
end if
! there should be a global check on k here!!!
@ -186,7 +186,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,&
end do
end do
call dgsum2d(icontxt,'a',' ',m,k,globx(1,jglobx),size(globx,1),root,mycol)
call dgsum2d(ictxt,'a',' ',m,k,globx(1,jglobx),size(globx,1),root,mycol)
call psb_erractionrestore(err_act)
return
@ -195,7 +195,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot,&
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -265,7 +265,7 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), root, iiroot, ilocx, iglobx, jlocx,&
& jglobx, lda_locx, lda_globx, lock, maxk, globk, m, k, jlx, ilx, i, j, idx
real(kind(1.d0)),pointer :: tmpx(:)
@ -276,10 +276,10 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -329,9 +329,9 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
k = 1
if (myrow == root) then
call igebs2d(icontxt, 'all', ' ', 1, 1, k, 1)
call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1)
else
call igebr2d(icontxt, 'all', ' ', 1, 1, k, 1, root, 0)
call igebr2d(ictxt, 'all', ' ', 1, 1, k, 1, root, 0)
end if
! there should be a global check on k here!!!
@ -366,7 +366,7 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
i=i+2
end do
call dgsum2d(icontxt,'a',' ',m,k,globx,size(globx),root,mycol)
call dgsum2d(ictxt,'a',' ',m,k,globx,size(globx),root,mycol)
call psb_erractionrestore(err_act)
return
@ -375,7 +375,7 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot,&
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

20
src/comm/psb_dhalo.f90
Unescape Escape View File

@ -62,7 +62,7 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
character, intent(in), optional :: tran
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, k, maxk, nrow, imode, i,&
& err, liwork, ncol
real(kind(1.d0)),pointer :: iwork(:), xp(:,:)
@ -74,10 +74,10 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -137,7 +137,7 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
end if
err=info
call psb_errcomm(icontxt,err)
call psb_errcomm(ictxt,err)
if(err.ne.0) goto 9999
if(present(alpha)) then
@ -203,7 +203,7 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -273,7 +273,7 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
character, intent(in), optional :: tran
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, k, maxk, nrow, imode, i,&
& err, liwork, ncol
real(kind(1.d0)),pointer :: iwork(:)
@ -285,10 +285,10 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -332,7 +332,7 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
end if
err=info
call psb_errcomm(icontxt,err)
call psb_errcomm(ictxt,err)
if(err.ne.0) goto 9999
if(present(alpha)) then
@ -389,7 +389,7 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

20
src/comm/psb_dovrl.f90
Unescape Escape View File

@ -58,7 +58,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update)
integer, intent(in), optional :: update,jx,ik
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
& imode, err, liwork, i
real(kind(1.d0)),pointer :: iwork(:), xp(:,:)
@ -70,10 +70,10 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -132,7 +132,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update)
end if
err=info
call psb_errcomm(icontxt,err)
call psb_errcomm(ictxt,err)
if(err.ne.0) goto 9999
! check for presence/size of a work area
@ -208,7 +208,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -275,7 +275,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,update)
integer, intent(in), optional :: update
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
& imode, err, liwork, i
real(kind(1.d0)),pointer :: iwork(:)
@ -287,10 +287,10 @@ subroutine psb_dovrlv(x,desc_a,info,work,update)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -335,7 +335,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,update)
end if
err=info
call psb_errcomm(icontxt,err)
call psb_errcomm(ictxt,err)
if(err.ne.0) goto 9999
! check for presence/size of a work area
@ -410,7 +410,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,update)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

36
src/comm/psb_dscatter.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), i, j, idx, nrow, iiroot, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, icomm, k, maxk, root, ilx,&
& jlx, myrank, rootrank, c, pos
@ -79,10 +79,10 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -153,8 +153,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
k = maxk
end if
call blacs_get(icontxt,10,icomm)
myrank = blacs_pnum(icontxt,myrow,mycol)
call blacs_get(ictxt,10,icomm)
myrank = blacs_pnum(ictxt,myrow,mycol)
lda_globx = size(globx)
lda_locx = size(locx)
@ -163,9 +163,9 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
n = desc_a%matrix_data(psb_n_)
if (myrow == iiroot) then
call igebs2d(icontxt, 'all', ' ', 1, 1, k, 1)
call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1)
else
call igebr2d(icontxt, 'all', ' ', 1, 1, k, 1, iiroot, 0)
call igebr2d(ictxt, 'all', ' ', 1, 1, k, 1, iiroot, 0)
end if
! there should be a global check on k here!!!
@ -196,7 +196,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
end do
end do
else
rootrank = blacs_pnum(icontxt,root,mycol)
rootrank = blacs_pnum(ictxt,root,mycol)
end if
! root has to gather size information
@ -258,7 +258,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot,&
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -326,7 +326,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), i, j, idx, nrow, iiroot, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, root, k, maxk, icomm, myrank,&
& rootrank, c, pos, ilx, jlx
@ -340,10 +340,10 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -367,8 +367,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
root = -1
end if
call blacs_get(icontxt,10,icomm)
myrank = blacs_pnum(icontxt,myrow,mycol)
call blacs_get(ictxt,10,icomm)
myrank = blacs_pnum(ictxt,myrow,mycol)
lda_globx = size(globx)
lda_locx = size(locx)
@ -379,9 +379,9 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
k = 1
if (myrow == iiroot) then
call igebs2d(icontxt, 'all', ' ', 1, 1, k, 1)
call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1)
else
call igebr2d(icontxt, 'all', ' ', 1, 1, k, 1, iiroot, 0)
call igebr2d(ictxt, 'all', ' ', 1, 1, k, 1, iiroot, 0)
end if
! there should be a global check on k here!!!
@ -410,7 +410,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
locx(i)=globx(idx)
end do
else
rootrank = blacs_pnum(icontxt,root,mycol)
rootrank = blacs_pnum(ictxt,root,mycol)
end if
! root has to gather size information
@ -454,7 +454,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

20
src/comm/psb_ihalo.f90
Unescape Escape View File

@ -63,7 +63,7 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
character, intent(in), optional :: tran
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, liwork,&
& imode, err
integer, pointer :: xp(:,:), iwork(:)
@ -75,10 +75,10 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -138,7 +138,7 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
end if
err=info
call psb_errcomm(icontxt,err)
call psb_errcomm(ictxt,err)
if(err.ne.0) goto 9999
@ -199,7 +199,7 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -269,7 +269,7 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode)
character, intent(in), optional :: tran
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, imode,&
& err, liwork
integer,pointer :: iwork(:)
@ -281,10 +281,10 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -330,7 +330,7 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode)
end if
err=info
call psb_errcomm(icontxt,err)
call psb_errcomm(ictxt,err)
if(err.ne.0) goto 9999
!!$ if(present(alpha)) then
@ -386,7 +386,7 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

28
src/comm/psb_zgather.f90
Unescape Escape View File

@ -62,7 +62,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,&
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), root, iiroot, ilocx, iglobx, jlocx,&
& jglobx, lda_locx, lda_globx, m, lock, globk, maxk, k, jlx, ilx, i, j, idx
complex(kind(1.d0)),pointer :: tmpx(:)
@ -73,10 +73,10 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,&
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -148,9 +148,9 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,&
end if
if (myrow == iiroot) then
call igebs2d(icontxt, 'all', ' ', 1, 1, k, 1)
call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1)
else
call igebr2d(icontxt, 'all', ' ', 1, 1, k, 1, iiroot, 0)
call igebr2d(ictxt, 'all', ' ', 1, 1, k, 1, iiroot, 0)
end if
! there should be a global check on k here!!!
@ -187,7 +187,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,&
end do
end do
call gsum2d(icontxt,'a',globx(:,jglobx),rrt=root)
call gsum2d(ictxt,'a',globx(:,jglobx),rrt=root)
call psb_erractionrestore(err_act)
return
@ -196,7 +196,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot,&
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -267,7 +267,7 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,&
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), root, iiroot, ilocx, iglobx, jlocx,&
& jglobx, lda_locx, lda_globx, lock, maxk, globk, m, k, jlx, ilx, i, j, idx
complex(kind(1.d0)),pointer :: tmpx(:)
@ -278,10 +278,10 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,&
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -331,9 +331,9 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,&
k = 1
if (myrow == root) then
call igebs2d(icontxt, 'all', ' ', 1, 1, k, 1)
call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1)
else
call igebr2d(icontxt, 'all', ' ', 1, 1, k, 1, root, 0)
call igebr2d(ictxt, 'all', ' ', 1, 1, k, 1, root, 0)
end if
! there should be a global check on k here!!!
@ -368,7 +368,7 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,&
i=i+2
end do
call dgsum2d(icontxt,'a',' ',m,k,globx,size(globx),root,mycol)
call dgsum2d(ictxt,'a',' ',m,k,globx,size(globx),root,mycol)
call psb_erractionrestore(err_act)
return
@ -377,7 +377,7 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot,&
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

20
src/comm/psb_zhalo.f90
Unescape Escape View File

@ -62,7 +62,7 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
character, intent(in), optional :: tran
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, k, maxk, nrow, imode, i,&
& err, liwork, ncol
complex(kind(1.d0)),pointer :: iwork(:), xp(:,:)
@ -74,10 +74,10 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -137,7 +137,7 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
end if
err=info
call psb_errcomm(icontxt,err)
call psb_errcomm(ictxt,err)
if(err.ne.0) goto 9999
if(present(alpha)) then
@ -197,7 +197,7 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -267,7 +267,7 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode)
character, intent(in), optional :: tran
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, k, maxk, nrow, imode, i,&
& err, liwork, ncol
complex(kind(1.d0)),pointer :: iwork(:)
@ -279,10 +279,10 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -326,7 +326,7 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode)
end if
err=info
call psb_errcomm(icontxt,err)
call psb_errcomm(ictxt,err)
if(err.ne.0) goto 9999
if(present(alpha)) then
@ -383,7 +383,7 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

20
src/comm/psb_zovrl.f90
Unescape Escape View File

@ -58,7 +58,7 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update)
integer, intent(in), optional :: update,jx,ik
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
& imode, err, liwork, i
complex(kind(1.d0)),pointer :: iwork(:), xp(:,:)
@ -70,10 +70,10 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -132,7 +132,7 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update)
end if
err=info
call psb_errcomm(icontxt,err)
call psb_errcomm(ictxt,err)
if(err.ne.0) goto 9999
! check for presence/size of a work area
@ -208,7 +208,7 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -275,7 +275,7 @@ subroutine psb_zovrlv(x,desc_a,info,work,update)
integer, intent(in), optional :: update
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), ix, ijx, nrow, ncol, k, maxk, iupdate,&
& imode, err, liwork, i
complex(kind(1.d0)),pointer :: iwork(:)
@ -287,10 +287,10 @@ subroutine psb_zovrlv(x,desc_a,info,work,update)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -335,7 +335,7 @@ subroutine psb_zovrlv(x,desc_a,info,work,update)
end if
err=info
call psb_errcomm(icontxt,err)
call psb_errcomm(ictxt,err)
if(err.ne.0) goto 9999
! check for presence/size of a work area
@ -411,7 +411,7 @@ subroutine psb_zovrlv(x,desc_a,info,work,update)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

36
src/comm/psb_zscatter.f90
Unescape Escape View File

@ -65,7 +65,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), i, j, idx, nrow, iiroot, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, icomm, k, maxk, root, ilx,&
& jlx, myrank, rootrank, c, pos
@ -79,10 +79,10 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -153,8 +153,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
k = maxk
end if
call blacs_get(icontxt,10,icomm)
myrank = blacs_pnum(icontxt,myrow,mycol)
call blacs_get(ictxt,10,icomm)
myrank = blacs_pnum(ictxt,myrow,mycol)
lda_globx = size(globx)
lda_locx = size(locx)
@ -163,9 +163,9 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
n = desc_a%matrix_data(psb_n_)
if (myrow == iiroot) then
call igebs2d(icontxt, 'all', ' ', 1, 1, k, 1)
call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1)
else
call igebr2d(icontxt, 'all', ' ', 1, 1, k, 1, iiroot, 0)
call igebr2d(ictxt, 'all', ' ', 1, 1, k, 1, iiroot, 0)
end if
! there should be a global check on k here!!!
@ -196,7 +196,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
end do
end do
else
rootrank = blacs_pnum(icontxt,root,mycol)
rootrank = blacs_pnum(ictxt,root,mycol)
end if
! root has to gather size information
@ -258,7 +258,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot,&
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -326,7 +326,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, m, n, iix, jjx, temp(2), i, j, idx, nrow, iiroot, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, root, k, maxk, icomm, myrank,&
& rootrank, c, pos, ilx, jlx
@ -340,10 +340,10 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -367,8 +367,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
root = -1
end if
call blacs_get(icontxt,10,icomm)
myrank = blacs_pnum(icontxt,myrow,mycol)
call blacs_get(ictxt,10,icomm)
myrank = blacs_pnum(ictxt,myrow,mycol)
lda_globx = size(globx)
lda_locx = size(locx)
@ -379,9 +379,9 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
k = 1
if (myrow == iiroot) then
call igebs2d(icontxt, 'all', ' ', 1, 1, k, 1)
call igebs2d(ictxt, 'all', ' ', 1, 1, k, 1)
else
call igebr2d(icontxt, 'all', ' ', 1, 1, k, 1, iiroot, 0)
call igebr2d(ictxt, 'all', ' ', 1, 1, k, 1, iiroot, 0)
end if
! there should be a global check on k here!!!
@ -410,7 +410,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
locx(i)=globx(idx)
end do
else
rootrank = blacs_pnum(icontxt,root,mycol)
rootrank = blacs_pnum(ictxt,root,mycol)
end if
! root has to gather size information
@ -454,7 +454,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

280
src/internals/ctof_blacs.h
Unescape Escape View File

@ -47,30 +47,30 @@ static int i1, i2, i3, i4, i5, i6, i7;
blacs_pinfo_(mypnum, nprocs)
#define Cblacs_setup(mypnum, nprocs) \
blacs_setup_(mypnum, nprocs)
#define Cblacs_get(icontxt, what, val) \
{i1 = icontxt; i2 = what; \
#define Cblacs_get(ictxt, what, val) \
{i1 = ictxt; i2 = what; \
blacs_get_(&i1, &i2,val);}
#define Cblacs_set(icontxt, what, val) \
{i1 = icontxt; i2 = what; \
#define Cblacs_set(ictxt, what, val) \
{i1 = ictxt; i2 = what; \
blacs_set_(&i1, &i2, &val);}
#define Cblacs_gridinit(icontxt, order, nprow, npcol) \
#define Cblacs_gridinit(ictxt, order, nprow, npcol) \
{i1 = nprow; i2 = npcol; \
blacs_gridinit_(icontxt, order, &i1, &i2);}
#define Cblacs_gridmap(icontxt, pmap, ldpmap, nprow, npcol) \
blacs_gridinit_(ictxt, order, &i1, &i2);}
#define Cblacs_gridmap(ictxt, pmap, ldpmap, nprow, npcol) \
{i1 = ldpmap; i2 = nprow; i3 = npcol; \
blacs_gridmap_(icontxt, pmap, &i1, &i2, &i3);}
blacs_gridmap_(ictxt, pmap, &i1, &i2, &i3);}
/* Support routines:
Destruction */
#define Cblacs_freebuff(icontxt, wait) \
{i1 = icontxt; i2 = wait; \
#define Cblacs_freebuff(ictxt, wait) \
{i1 = ictxt; i2 = wait; \
blacs_freebuff_(&i1, &i2);}
#define Cblacs_gridexit(icontxt) \
{i1 = icontxt; \
#define Cblacs_gridexit(ictxt) \
{i1 = ictxt; \
blacs_gridexit_(&i1);}
#define Cblacs_abort(icontxt, errornum) \
{i1 = icontxt; i2 = errornum; \
#define Cblacs_abort(ictxt, errornum) \
{i1 = ictxt; i2 = errornum; \
blacs_abort_(&i1, &i2);}
#define Cblacs_exit(doneflag) \
{i1 = doneflag; \
@ -79,17 +79,17 @@ static int i1, i2, i3, i4, i5, i6, i7;
/* Support routines:
Informational and Miscellaneous */
#define Cblacs_gridinfo(icontxt,nprow,npcol,myprow,mypcol) \
{i1 = icontxt; \
#define Cblacs_gridinfo(ictxt,nprow,npcol,myprow,mypcol) \
{i1 = ictxt; \
blacs_gridinfo_(&i1, nprow, npcol, myprow, mypcol);}
#define Cblacs_pnum(icontxt, prow, pcol) \
{i1 = icontxt; i2 = prow; i3 = pcol; \
#define Cblacs_pnum(ictxt, prow, pcol) \
{i1 = ictxt; i2 = prow; i3 = pcol; \
blacs_pnum_(&i1, &i2, &i3);}
#define Cblacs_pcoord(icontxt, pnum, prow, pcol) \
{i1 = icontxt; i2 = pnum; \
#define Cblacs_pcoord(ictxt, pnum, prow, pcol) \
{i1 = ictxt; i2 = pnum; \
blacs_pcoord_(&i1, &i2, prow, pcol);}
#define Cblacs_barrier(icontxt, scope) \
{i1 = icontxt; \
#define Cblacs_barrier(ictxt, scope) \
{i1 = ictxt; \
blacs_barrier_(&i1, scope);}
/* Support routines:
@ -102,242 +102,242 @@ static int i1, i2, i3, i4, i5, i6, i7;
dcputime_()
#define Cdwalltime() \
dwalltime_()
#define Cksendid(icontxt, rdest, cdest) \
{i1 = icontxt; i2 = rdest; i3 = cdest; \
#define Cksendid(ictxt, rdest, cdest) \
{i1 = ictxt; i2 = rdest; i3 = cdest; \
ksendid_(&i1, &i2, &i3);}
#define Ckrecvid(icontxt, rsrc, csrc) \
{i1 = icontxt; i2 = rsrc; i3 = csrc; \
#define Ckrecvid(ictxt, rsrc, csrc) \
{i1 = ictxt; i2 = rsrc; i3 = csrc; \
krecvid_(&i1, &i2, &i3);}
#define Ckbsid(icontxt, scope) \
{i1 = icontxt; \
#define Ckbsid(ictxt, scope) \
{i1 = ictxt; \
kbsid_(&i1, scope);}
#define Ckbrid(icontxt, scope, rsrc, csrc) \
{i1 = icontxt; i2 = rsrc; i3 = csrc; \
#define Ckbrid(ictxt, scope, rsrc, csrc) \
{i1 = ictxt; i2 = rsrc; i3 = csrc; \
kbrid_(&i1, scope, &i2, &i3);}
/* Point to Point :
Integer */
#define Cigesd2d(icontxt, m, n, A, lda, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
#define Cigesd2d(ictxt, m, n, A, lda, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
igesd2d_(&i1, &i2, &i3, A, &i4, &i5, &i6);}
#define Cigerv2d(icontxt, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Cigerv2d(ictxt, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
igerv2d_(&i1, &i2, &i3, A, &i4, &i5, &i6);}
#define Citrsd2d(icontxt, uplo, diag, m, n, A, lda, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
#define Citrsd2d(ictxt, uplo, diag, m, n, A, lda, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
itrsd2d_(&i1, uplo, diag, &i2, &i3, A, &i4, &i5, &i6);}
#define Citrrv2d(icontxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Citrrv2d(ictxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
itrsd2d_(&i1, uplo, diag, &i2, &i3, A, &i4, &i5, &i6);}
/* Point to Point :
Single precision real */
#define Csgesd2d(icontxt, m, n, A, lda, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
#define Csgesd2d(ictxt, m, n, A, lda, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
sgesd2d_(&i1, &i2, &i3, A, &i4, &i5, &i6);}
#define Csgerv2d(icontxt, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Csgerv2d(ictxt, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
sgerv2d_(&i1, &i2, &i3, A, &i4, &i5, &i6);}
#define Cstrsd2d(icontxt, uplo, diag, m, n, A, lda, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
#define Cstrsd2d(ictxt, uplo, diag, m, n, A, lda, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
strsd2d_(&i1, uplo, diag, &i2, &i3, A, &i4, &i5, &i6);}
#define Cstrrv2d(icontxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Cstrrv2d(ictxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
strsd2d_(&i1, uplo, diag, &i2, &i3, A, &i4, &i5, &i6);}
/* Point to Point :
Double precision real */
#define Cdgesd2d(icontxt, m, n, A, lda, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
#define Cdgesd2d(ictxt, m, n, A, lda, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
dgesd2d_(&i1, &i2, &i3, A, &i4, &i5, &i6);}
#define Cdgerv2d(icontxt, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Cdgerv2d(ictxt, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
dgerv2d_(&i1, &i2, &i3, A, &i4, &i5, &i6);}
#define Cdtrsd2d(icontxt, uplo, diag, m, n, A, lda, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
#define Cdtrsd2d(ictxt, uplo, diag, m, n, A, lda, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
dtrsd2d_(&i1, uplo, diag, &i2, &i3, A, &i4, &i5, &i6);}
#define Cdtrrv2d(icontxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Cdtrrv2d(ictxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
dtrsd2d_(&i1, uplo, diag, &i2, &i3, A, &i4, &i5, &i6);}
/* Point to Point :
Single precision complex */
#define Ccgesd2d(icontxt, m, n, A, lda, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
#define Ccgesd2d(ictxt, m, n, A, lda, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
cgesd2d_(&i1, &i2, &i3, A, &i4, &i5, &i6);}
#define Ccgerv2d(icontxt, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Ccgerv2d(ictxt, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
cgerv2d_(&i1, &i2, &i3, A, &i4, &i5, &i6);}
#define Cctrsd2d(icontxt, uplo, diag, m, n, A, lda, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
#define Cctrsd2d(ictxt, uplo, diag, m, n, A, lda, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
ctrsd2d_(&i1, uplo, diag, &i2, &i3, A, &i4, &i5, &i6);}
#define Cctrrv2d(icontxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Cctrrv2d(ictxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
ctrsd2d_(&i1, uplo, diag, &i2, &i3, A, &i4, &i5, &i6);}
/* Point to Point :
Double precision complex */
#define Czgesd2d(icontxt, m, n, A, lda, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
#define Czgesd2d(ictxt, m, n, A, lda, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
zgesd2d_(&i1, &i2, &i3, A, &i4, &i5, &i6);}
#define Czgerv2d(icontxt, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Czgerv2d(ictxt, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
zgerv2d_(&i1, &i2, &i3, A, &i4, &i5, &i6);}
#define Cztrsd2d(icontxt, uplo, diag, m, n, A, lda, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
#define Cztrsd2d(ictxt, uplo, diag, m, n, A, lda, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
ztrsd2d_(&i1, uplo, diag, &i2, &i3, A, &i4, &i5, &i6);}
#define Cztrrv2d(icontxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Cztrrv2d(ictxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
ztrsd2d_(&i1, uplo, diag, &i2, &i3, A, &i4, &i5, &i6);}
/* Broadcasts :
Integer */
#define Cigebs2d(icontxt, scope, top, m, n, A, lda) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; \
#define Cigebs2d(ictxt, scope, top, m, n, A, lda) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; \
igebs2d_(&i1, scope, top, &i2, &i3, A, &i4);}
#define Cigebr2d(icontxt, scope, top, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Cigebr2d(ictxt, scope, top, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
igebr2d_(&i1, scope, top, &i2, &i3, A, &i4, &i5, &i6);}
#define Citrbs2d(icontxt, scope, top, uplo, diag, m, n, A, lda) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; \
#define Citrbs2d(ictxt, scope, top, uplo, diag, m, n, A, lda) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; \
itrbs2d_(&i1, scope, top, uplo, diag, &i2, &i3, A, &i4);}
#define Citrbr2d(icontxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Citrbr2d(ictxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
igebr2d_(&i1, uplo, diag, &i2, &i3, A, &i4, &i5, &i6);}
/* Broadcasts :
Single precision real */
#define Csgebs2d(icontxt, scope, top, m, n, A, lda) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; \
#define Csgebs2d(ictxt, scope, top, m, n, A, lda) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; \
sgebs2d_(&i1, scope, top, &i2, &i3, A, &i4);}
#define Csgebr2d(icontxt, scope, top, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Csgebr2d(ictxt, scope, top, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
sgebr2d_(&i1, scope, top, &i2, &i3, A, &i4, &i5, &i6);}
#define Cstrbs2d(icontxt, scope, top, uplo, diag, m, n, A, lda) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; \
#define Cstrbs2d(ictxt, scope, top, uplo, diag, m, n, A, lda) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; \
strbs2d_(&i1, scope, top, uplo, diag, &i2, &i3, A, &i4);}
#define Cstrbr2d(icontxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Cstrbr2d(ictxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
sgebr2d_(&i1, uplo, diag, &i2, &i3, A, &i4, &i5, &i6);}
/* Broadcasts :
Double precision real */
#define Cdgebs2d(icontxt, scope, top, m, n, A, lda) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; \
#define Cdgebs2d(ictxt, scope, top, m, n, A, lda) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; \
dgebs2d_(&i1, scope, top, &i2, &i3, A, &i4);}
#define Cdgebr2d(icontxt, scope, top, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Cdgebr2d(ictxt, scope, top, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
dgebr2d_(&i1, scope, top, &i2, &i3, A, &i4, &i5, &i6);}
#define Cdtrbs2d(icontxt, scope, top, uplo, diag, m, n, A, lda) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; \
#define Cdtrbs2d(ictxt, scope, top, uplo, diag, m, n, A, lda) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; \
dtrbs2d_(&i1, scope, top, uplo, diag, &i2, &i3, A, &i4);}
#define Cdtrbr2d(icontxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Cdtrbr2d(ictxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
dgebr2d_(&i1, uplo, diag, &i2, &i3, A, &i4, &i5, &i6);}
/* Broadcasts :
Single precision complex */
#define Ccgebs2d(icontxt, scope, top, m, n, A, lda) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; \
#define Ccgebs2d(ictxt, scope, top, m, n, A, lda) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; \
cgebs2d_(&i1, scope, top, &i2, &i3, A, &i4);}
#define Ccgebr2d(icontxt, scope, top, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Ccgebr2d(ictxt, scope, top, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
cgebr2d_(&i1, scope, top, &i2, &i3, A, &i4, &i5, &i6);}
#define Cctrbs2d(icontxt, scope, top, uplo, diag, m, n, A, lda) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; \
#define Cctrbs2d(ictxt, scope, top, uplo, diag, m, n, A, lda) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; \
ctrbs2d_(&i1, scope, top, uplo, diag, &i2, &i3, A, &i4);}
#define Cctrbr2d(icontxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Cctrbr2d(ictxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
cgebr2d_(&i1, uplo, diag, &i2, &i3, A, &i4, &i5, &i6);}
/* Broadcasts :
Double precision complex */
#define Czgebs2d(icontxt, scope, top, m, n, A, lda) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; \
#define Czgebs2d(ictxt, scope, top, m, n, A, lda) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; \
zgebs2d_(&i1, scope, top, &i2, &i3, A, &i4);}
#define Czgebr2d(icontxt, scope, top, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Czgebr2d(ictxt, scope, top, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
zgebr2d_(&i1, scope, top, &i2, &i3, A, &i4, &i5, &i6);}
#define Cztrbs2d(icontxt, scope, top, uplo, diag, m, n, A, lda) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; \
#define Cztrbs2d(ictxt, scope, top, uplo, diag, m, n, A, lda) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; \
ztrbs2d_(&i1, scope, top, uplo, diag, &i2, &i3, A, &i4);}
#define Cztrbr2d(icontxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
#define Cztrbr2d(ictxt, uplo, diag, m, n, A, lda, rsrc, csrc) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rsrc; i6 = csrc; \
zgebr2d_(&i1, uplo, diag, &i2, &i3, A, &i4, &i5, &i6);}
/* Combines:
Integer */
#define Cigsum2d(icontxt, scope, top, m, n, A, lda, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
#define Cigsum2d(ictxt, scope, top, m, n, A, lda, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
igsum2d_(&i1, scope, top, &i2, &i3, A, &i4, &i5, &i6);}
#define Cigamx2d(icontxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
#define Cigamx2d(ictxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
igamx2d_(&i1, scope, top, &i2, &i3, A, &i4, RA, CA, &i5, &i6, &i7);}
#define Cigamn2d(icontxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
#define Cigamn2d(ictxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
igamn2d_(&i1, scope, top, &i2, &i3, A, &i4, RA, CA, &i5, &i6, &i7);}
/* Combines:
Single precision real */
#define Csgsum2d(icontxt, scope, top, m, n, A, lda, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
#define Csgsum2d(ictxt, scope, top, m, n, A, lda, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
sgsum2d_(&i1, scope, top, &i2, &i3, A, &i4, &i5, &i6);}
#define Csgamx2d(icontxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
#define Csgamx2d(ictxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
sgamx2d_(&i1, scope, top, &i2, &i3, A, &i4, RA, CA, &i5, &i6, &i7);}
#define Csgamn2d(icontxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
#define Csgamn2d(ictxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
sgamn2d_(&i1, scope, top, &i2, &i3, A, &i4, RA, CA, &i5, &i6, &i7);}
/* Combines:
Double precision real */
#define Cdgsum2d(icontxt, scope, top, m, n, A, lda, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
#define Cdgsum2d(ictxt, scope, top, m, n, A, lda, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
dgsum2d_(&i1, scope, top, &i2, &i3, A, &i4, &i5, &i6);}
#define Cdgamx2d(icontxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
#define Cdgamx2d(ictxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
dgamx2d_(&i1, scope, top, &i2, &i3, A, &i4, RA, CA, &i5, &i6, &i7);}
#define Cdgamn2d(icontxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
#define Cdgamn2d(ictxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
dgamn2d_(&i1, scope, top, &i2, &i3, A, &i4, RA, CA, &i5, &i6, &i7);}
/* Combines:
Single precision complex */
#define Ccgsum2d(icontxt, scope, top, m, n, A, lda, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
#define Ccgsum2d(ictxt, scope, top, m, n, A, lda, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
cgsum2d_(&i1, scope, top, &i2, &i3, A, &i4, &i5, &i6);}
#define Ccgamx2d(icontxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
#define Ccgamx2d(ictxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
cgamx2d_(&i1, scope, top, &i2, &i3, A, &i4, RA, CA, &i5, &i6, &i7);}
#define Ccgamn2d(icontxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
#define Ccgamn2d(ictxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
cgamn2d_(&i1, scope, top, &i2, &i3, A, &i4, RA, CA, &i5, &i6, &i7);}
/* Combines:
Double precision complex */
#define Czgsum2d(icontxt, scope, top, m, n, A, lda, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
#define Czgsum2d(ictxt, scope, top, m, n, A, lda, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = rdest; i6 = cdest; \
zgsum2d_(&i1, scope, top, &i2, &i3, A, &i4, &i5, &i6);}
#define Czgamx2d(icontxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
#define Czgamx2d(ictxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
zgamx2d_(&i1, scope, top, &i2, &i3, A, &i4, RA, CA, &i5, &i6, &i7);}
#define Czgamn2d(icontxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = icontxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
#define Czgamn2d(ictxt, scope, top, m, n, A, lda, RA, CA, RCflag, rdest, cdest) \
{i1 = ictxt; i2 = m; i3 = n; i4 = lda; i5 = RCflag; i6 = rdest; i7 = cdest; \
zgamn2d_(&i1, scope, top, &i2, &i3, A, &i4, RA, CA, &i5, &i6, &i7);}

10
src/internals/psi_compute_size.f90
Unescape Escape View File

@ -41,7 +41,7 @@ subroutine psi_compute_size(desc_data,&
integer :: desc_data(:), index_in(:)
! ....local scalars....
integer :: i,npcol,nprow,mycol,myrow,proc,counter, max_index
integer :: icontxt, err, err_act, np
integer :: ictxt, err, err_act, np
! ...local array...
integer :: exch(2)
integer :: int_err(5)
@ -55,9 +55,9 @@ subroutine psi_compute_size(desc_data,&
call psb_get_erraction(err_act)
info = 0
icontxt = desc_data(psb_ctxt_)
ictxt = desc_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,myrow,mycol)
call blacs_gridinfo(ictxt,nprow,npcol,myrow,mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -113,7 +113,7 @@ subroutine psi_compute_size(desc_data,&
enddo
! computing max global value of dl_lda
call igamx2d(icontxt, psb_all_, psb_topdef_, 1, ione, dl_lda, &
call igamx2d(ictxt, psb_all_, psb_topdef_, 1, ione, dl_lda, &
&1, counter, counter, -ione ,-ione,-ione)
if (debug) then
@ -126,7 +126,7 @@ subroutine psi_compute_size(desc_data,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

8
src/internals/psi_crea_index.f90
Unescape Escape View File

@ -44,7 +44,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
! ....local scalars...
integer :: me,npcol,mycol,nprow,i,j,k,&
& mode, int_err(5), err, err_act, np,&
& dl_lda, icontxt, proc, nerv, nesd
& dl_lda, ictxt, proc, nerv, nesd
! ...parameters...
integer, pointer :: dep_list(:,:), length_dl(:)
integer,parameter :: root=0,no_comm=-1
@ -88,8 +88,8 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
name='psi_crea_index'
call psb_erractionsave(err_act)
icontxt = desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,np,npcol,me,mycol)
ictxt = desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,np,npcol,me,mycol)
if (np == -1) then
info = 2010
call psb_errpush(info,name)
@ -159,7 +159,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

20
src/internals/psi_desc_index.f90
Unescape Escape View File

@ -47,7 +47,7 @@ subroutine psi_desc_index(desc_data,index_in,dep_list,&
!c ....local scalars...
integer :: j,me,np,npcol,mycol,i,proc,dim
!c ...parameters...
integer :: icontxt
integer :: ictxt
integer :: no_comm,err
parameter (no_comm=-1)
!c ...local arrays..
@ -67,8 +67,8 @@ subroutine psi_desc_index(desc_data,index_in,dep_list,&
!c if mode == 1 then we can use glob_to_loc array
!c else we can't utilize it
icontxt=desc_data(psb_ctxt_)
call blacs_gridinfo(icontxt,np,npcol,me,mycol)
ictxt=desc_data(psb_ctxt_)
call blacs_gridinfo(ictxt,np,npcol,me,mycol)
if (np == -1) then
info = 2010
call psb_errpush(info,name)
@ -82,10 +82,10 @@ subroutine psi_desc_index(desc_data,index_in,dep_list,&
if (debug) then
write(0,*) me,'start desc_index'
call blacs_barrier(icontxt,'all')
call blacs_barrier(ictxt,'all')
endif
call blacs_get(icontxt,10,icomm)
call blacs_get(ictxt,10,icomm)
!c
!c first, find out the total sizes to be exchanged.
!c note: things marked here as sndbuf/rcvbuf (for mpi) corresponds to things
@ -136,7 +136,7 @@ subroutine psi_desc_index(desc_data,index_in,dep_list,&
end if
if (debug) then
write(0,*) me,'computed sizes ',iszr,iszs
call blacs_barrier(icontxt,'all')
call blacs_barrier(ictxt,'all')
endif
ntot = (3*(max(count(sdsz>0),count(rvsz>0)))+ iszs + iszr) + 1
@ -153,7 +153,7 @@ subroutine psi_desc_index(desc_data,index_in,dep_list,&
if (debug) then
write(0,*) me,'computed allocated workspace ',iszr,iszs
call blacs_barrier(icontxt,'all')
call blacs_barrier(ictxt,'all')
endif
allocate(sndbuf(iszs),rcvbuf(iszr),stat=info)
if(info /= 0) then
@ -190,7 +190,7 @@ subroutine psi_desc_index(desc_data,index_in,dep_list,&
if (debug) then
write(0,*) me,' prepared send buffer '
call blacs_barrier(icontxt,'all')
call blacs_barrier(ictxt,'all')
endif
!c
!c now have to regenerate bsdindx
@ -245,7 +245,7 @@ subroutine psi_desc_index(desc_data,index_in,dep_list,&
if (debug) then
write(0,*) me,'end desc_index'
call blacs_barrier(icontxt,'all')
call blacs_barrier(ictxt,'all')
endif
call psb_erractionrestore(err_act)
@ -254,7 +254,7 @@ subroutine psi_desc_index(desc_data,index_in,dep_list,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

56
src/internals/psi_dswapdata.f90
Unescape Escape View File

@ -43,7 +43,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: icontxt, nprow, npcol, myrow,&
integer :: ictxt, nprow, npcol, myrow,&
& mycol, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
@ -99,8 +99,8 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
name='psi_dswap_data'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,myrow,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,myrow,mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -112,7 +112,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
goto 9999
endif
call blacs_get(icontxt,10,icomm)
call blacs_get(ictxt,10,icomm)
allocate(sdsz(0:nprow-1), rvsz(0:nprow-1), bsdidx(0:nprow-1),&
& brvidx(0:nprow-1), rvhd(0:nprow-1), prcid(0:nprow-1),&
@ -152,7 +152,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
nerv = d_idx(point_to_proc+psb_n_elem_recv_)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = blacs_pnum(icontxt,proc_to_comm,mycol)
prcid(proc_to_comm) = blacs_pnum(ictxt,proc_to_comm,mycol)
ptp(proc_to_comm) = point_to_proc
brvidx(proc_to_comm) = idxr
@ -240,20 +240,20 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,n,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd*n-1))
call dgesd2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgesd2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
! Then I receive
rcv_pt = brvidx(proc_to_comm)
call dgerv2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgerv2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
else if (proc_to_comm .gt. myrow) then
! First I receive
rcv_pt = brvidx(proc_to_comm)
call dgerv2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgerv2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
! Then I send
idx_pt = point_to_proc+nerv+psb_elem_send_
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,n,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd*n-1))
call dgesd2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgesd2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
else if (proc_to_comm .eq. myrow) then
! I send to myself
idx_pt = point_to_proc+nerv+psb_elem_send_
@ -297,7 +297,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
if(proc_to_comm.ne.myrow) then
p2ptag = krecvid(icontxt,proc_to_comm,myrow)
p2ptag = krecvid(ictxt,proc_to_comm,myrow)
rcv_pt = brvidx(proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),rvsz(proc_to_comm),&
& mpi_double_precision,prcid(proc_to_comm),&
@ -328,7 +328,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
& y,sndbuf(snd_pt:snd_pt+nesd*n-1))
if(proc_to_comm .ne. myrow) then
p2ptag=ksendid(icontxt,proc_to_comm,myrow)
p2ptag=ksendid(ictxt,proc_to_comm,myrow)
call mpi_send(sndbuf(snd_pt),sdsz(proc_to_comm),&
& mpi_double_precision,prcid(proc_to_comm),&
& p2ptag,icomm,iret)
@ -435,7 +435,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,n,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd*n-1))
call dgesd2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgesd2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
point_to_proc = point_to_proc+nerv+nesd+3
proc_to_comm = d_idx(point_to_proc+psb_proc_id_)
@ -451,7 +451,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
if(proc_to_comm.ne.myrow) then
rcv_pt = brvidx(proc_to_comm)
call dgerv2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgerv2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_sct(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
@ -484,7 +484,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -536,7 +536,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: icontxt, nprow, npcol, myrow,&
integer :: ictxt, nprow, npcol, myrow,&
& mycol, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
@ -593,8 +593,8 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
name='psi_dswap_datav'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,myrow,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,myrow,mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -606,7 +606,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
goto 9999
endif
call blacs_get(icontxt,10,icomm)
call blacs_get(ictxt,10,icomm)
allocate(sdsz(0:nprow-1), rvsz(0:nprow-1), bsdidx(0:nprow-1),&
@ -648,7 +648,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
nerv = d_idx(point_to_proc+psb_n_elem_recv_)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = blacs_pnum(icontxt,proc_to_comm,mycol)
prcid(proc_to_comm) = blacs_pnum(ictxt,proc_to_comm,mycol)
ptp(proc_to_comm) = point_to_proc
brvidx(proc_to_comm) = idxr
@ -735,20 +735,20 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd-1))
call dgesd2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgesd2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
! Then I receive
rcv_pt = brvidx(proc_to_comm)
call dgerv2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgerv2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
else if (proc_to_comm .gt. myrow) then
! First I receive
rcv_pt = brvidx(proc_to_comm)
call dgerv2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgerv2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
! Then I send
idx_pt = point_to_proc+nerv+psb_elem_send_
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd-1))
call dgesd2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgesd2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
else if (proc_to_comm .eq. myrow) then
! I send to myself
idx_pt = point_to_proc+nerv+psb_elem_send_
@ -792,7 +792,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
if(proc_to_comm.ne.myrow) then
p2ptag = krecvid(icontxt,proc_to_comm,myrow)
p2ptag = krecvid(ictxt,proc_to_comm,myrow)
rcv_pt = brvidx(proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),rvsz(proc_to_comm),&
& mpi_double_precision,prcid(proc_to_comm),&
@ -822,7 +822,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
& y,sndbuf(snd_pt:snd_pt+nesd-1))
if(proc_to_comm .ne. myrow) then
p2ptag=ksendid(icontxt,proc_to_comm,myrow)
p2ptag=ksendid(ictxt,proc_to_comm,myrow)
call mpi_send(sndbuf(snd_pt),sdsz(proc_to_comm),&
& mpi_double_precision,prcid(proc_to_comm),&
& p2ptag,icomm,iret)
@ -930,7 +930,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd-1))
call dgesd2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgesd2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
point_to_proc = point_to_proc+nerv+nesd+3
proc_to_comm = d_idx(point_to_proc+psb_proc_id_)
@ -946,7 +946,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
if(proc_to_comm.ne.myrow) then
rcv_pt = brvidx(proc_to_comm)
call dgerv2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgerv2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_sct(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
@ -979,7 +979,7 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

56
src/internals/psi_dswaptran.f90
Unescape Escape View File

@ -43,7 +43,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: icontxt, nprow, npcol, myrow,&
integer :: ictxt, nprow, npcol, myrow,&
& mycol, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
@ -100,8 +100,8 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
name='psi_dswaptranm'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,myrow,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,myrow,mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -113,7 +113,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
goto 9999
endif
call blacs_get(icontxt,10,icomm)
call blacs_get(ictxt,10,icomm)
allocate(sdsz(0:nprow-1), rvsz(0:nprow-1), bsdidx(0:nprow-1),&
& brvidx(0:nprow-1), rvhd(0:nprow-1), prcid(0:nprow-1),&
@ -153,7 +153,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
nerv = d_idx(point_to_proc+psb_n_elem_recv_)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = blacs_pnum(icontxt,proc_to_comm,mycol)
prcid(proc_to_comm) = blacs_pnum(ictxt,proc_to_comm,mycol)
ptp(proc_to_comm) = point_to_proc
brvidx(proc_to_comm) = idxr
@ -241,20 +241,20 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
call dgesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgesd2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
! Then I receive
snd_pt = brvidx(proc_to_comm)
call dgerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgerv2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
else if (proc_to_comm .gt. myrow) then
! First I receive
snd_pt = bsdidx(proc_to_comm)
call dgerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgerv2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
! Then I send
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
call dgesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgesd2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
else if (proc_to_comm .eq. myrow) then
! I send to myself
idx_pt = point_to_proc+psb_elem_recv_
@ -299,7 +299,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
if(proc_to_comm.ne.myrow) then
p2ptag = krecvid(icontxt,proc_to_comm,myrow)
p2ptag = krecvid(ictxt,proc_to_comm,myrow)
snd_pt = brvidx(proc_to_comm)
call mpi_irecv(sndbuf(rcv_pt),sdsz(proc_to_comm),&
& mpi_double_precision,prcid(proc_to_comm),&
@ -329,7 +329,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
if(proc_to_comm .ne. myrow) then
p2ptag=ksendid(icontxt,proc_to_comm,myrow)
p2ptag=ksendid(ictxt,proc_to_comm,myrow)
call mpi_send(rcvbuf(rcv_pt),rvsz(proc_to_comm),&
& mpi_double_precision,prcid(proc_to_comm),&
& p2ptag,icomm,iret)
@ -436,7 +436,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
call dgesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgesd2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
point_to_proc = point_to_proc+nerv+nesd+3
proc_to_comm = d_idx(point_to_proc+psb_proc_id_)
@ -452,7 +452,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
if(proc_to_comm.ne.myrow) then
snd_pt = bsdidx(proc_to_comm)
call dgerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgerv2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
idx_pt = point_to_proc+nerv+psb_elem_send_
call psi_sct(nesd,n,d_idx(idx_pt:idx_pt+nesd-1),&
& sndbuf(snd_pt:snd_pt+n*nesd-1),beta,y)
@ -484,7 +484,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -541,7 +541,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: icontxt, nprow, npcol, myrow,&
integer :: ictxt, nprow, npcol, myrow,&
& mycol, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
@ -598,8 +598,8 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
name='psi_dswaptranv'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,myrow,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,myrow,mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -611,7 +611,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
goto 9999
endif
call blacs_get(icontxt,10,icomm)
call blacs_get(ictxt,10,icomm)
allocate(sdsz(0:nprow-1), rvsz(0:nprow-1), bsdidx(0:nprow-1),&
& brvidx(0:nprow-1), rvhd(0:nprow-1), prcid(0:nprow-1),&
@ -652,7 +652,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
nerv = d_idx(point_to_proc+psb_n_elem_recv_)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = blacs_pnum(icontxt,proc_to_comm,mycol)
prcid(proc_to_comm) = blacs_pnum(ictxt,proc_to_comm,mycol)
ptp(proc_to_comm) = point_to_proc
brvidx(proc_to_comm) = idxr
@ -739,20 +739,20 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
call dgesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgesd2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
! Then I receive
snd_pt = brvidx(proc_to_comm)
call dgerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgerv2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
else if (proc_to_comm .gt. myrow) then
! First I receive
snd_pt = bsdidx(proc_to_comm)
call dgerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgerv2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
! Then I send
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
call dgesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgesd2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
else if (proc_to_comm .eq. myrow) then
! I send to myself
idx_pt = point_to_proc+psb_elem_recv_
@ -797,7 +797,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
if(proc_to_comm.ne.myrow) then
p2ptag = krecvid(icontxt,proc_to_comm,myrow)
p2ptag = krecvid(ictxt,proc_to_comm,myrow)
snd_pt = brvidx(proc_to_comm)
call mpi_irecv(sndbuf(snd_pt),sdsz(proc_to_comm),&
& mpi_double_precision,prcid(proc_to_comm),&
@ -827,7 +827,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
if(proc_to_comm .ne. myrow) then
p2ptag=ksendid(icontxt,proc_to_comm,myrow)
p2ptag=ksendid(ictxt,proc_to_comm,myrow)
call mpi_send(rcvbuf(rcv_pt),rvsz(proc_to_comm),&
& mpi_double_precision,prcid(proc_to_comm),&
& p2ptag,icomm,iret)
@ -934,7 +934,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
call dgesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call dgesd2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
point_to_proc = point_to_proc+nerv+nesd+3
proc_to_comm = d_idx(point_to_proc+psb_proc_id_)
@ -950,7 +950,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
if(proc_to_comm.ne.myrow) then
snd_pt = bsdidx(proc_to_comm)
call dgerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call dgerv2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_sct(nesd,d_idx(idx_pt:idx_pt+nesd-1),&
@ -983,7 +983,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

22
src/internals/psi_extrct_dl.f
Unescape Escape View File

@ -135,7 +135,7 @@ c .....local arrays....
c .....local scalars...
integer i,nprow,npcol,me,mycol,pointer_dep_list,proc,j,err_act
integer icontxt, err, icomm
integer ictxt, err, icomm
logical debug
parameter (debug=.false.)
character name*20
@ -143,10 +143,10 @@ c .....local scalars...
call fcpsb_get_erraction(err_act)
info = 0
icontxt = desc_data(psb_ctxt_)
ictxt = desc_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
do i=0,np
length_dl(i) = 0
enddo
@ -244,14 +244,14 @@ c ... check for errors...
998 continue
if (debug) write(0,*) 'extract: info ',info
err = info
c$$$ call igamx2d(icontxt, all, topdef, ione, ione, err, ione,
c$$$ call igamx2d(ictxt, all, topdef, ione, ione, err, ione,
c$$$ + i, i, -ione ,-ione,-ione)
if (err.ne.0) goto 9999
if (.true.) then
call igsum2d(icontxt,'all',' ',np+1,1,length_dl,np+1,-1,-1)
call blacs_get(icontxt,10,icomm )
call igsum2d(ictxt,'all',' ',np+1,1,length_dl,np+1,-1,-1)
call blacs_get(ictxt,10,icomm )
allocate(itmp(dl_lda),stat=info)
if (info /= 0) goto 9999
itmp(1:dl_lda) = dep_list(1:dl_lda,me)
@ -266,11 +266,11 @@ c$$$ + i, i, -ione ,-ione,-ione)
if (proc.ne.psb_root_) then
if (debug) write(0,*) 'receiving from: ',proc
c ...receive from proc length of its dependence list....
call igerv2d(icontxt,1,1,length_dl(proc),1,
call igerv2d(ictxt,1,1,length_dl(proc),1,
+ proc,mycol)
c ...receive from proc its dependence list....
call igerv2d(icontxt,length_dl(proc),1,
call igerv2d(ictxt,length_dl(proc),1,
+ dep_list(1,proc),length_dl(proc),proc,mycol)
endif
@ -278,10 +278,10 @@ c ...receive from proc its dependence list....
else if (me.ne.psb_root_) then
c ...send to root dependence list length.....
if (debug) write(0,*) 'sending to: ',me,psb_root_
call igesd2d(icontxt,1,1,length_dl(me),1,psb_root_,mycol)
call igesd2d(ictxt,1,1,length_dl(me),1,psb_root_,mycol)
if (debug) write(0,*) 'sending to: ',me,psb_root_
c ...send to root dependence list....
call igesd2d(icontxt,length_dl(me),1,dep_list(1,me),
call igesd2d(ictxt,length_dl(me),1,dep_list(1,me),
+ length_dl(me),psb_root_,mycol)
endif
@ -292,7 +292,7 @@ c ...send to root dependence list....
9999 continue
call fcpsb_errpush(info,name,int_err)
if(err_act.eq.act_abort) then
call fcpsb_perror(icontxt)
call fcpsb_perror(ictxt)
endif
return

56
src/internals/psi_iswapdata.f90
Unescape Escape View File

@ -43,7 +43,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: icontxt, nprow, npcol, myrow,&
integer :: ictxt, nprow, npcol, myrow,&
& mycol, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
@ -99,8 +99,8 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
name='psi_dswap_data'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,myrow,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,myrow,mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -112,7 +112,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
goto 9999
endif
call blacs_get(icontxt,10,icomm)
call blacs_get(ictxt,10,icomm)
allocate(sdsz(0:nprow-1), rvsz(0:nprow-1), bsdidx(0:nprow-1),&
& brvidx(0:nprow-1), rvhd(0:nprow-1), prcid(0:nprow-1),&
@ -152,7 +152,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
nerv = d_idx(point_to_proc+psb_n_elem_recv_)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = blacs_pnum(icontxt,proc_to_comm,mycol)
prcid(proc_to_comm) = blacs_pnum(ictxt,proc_to_comm,mycol)
ptp(proc_to_comm) = point_to_proc
brvidx(proc_to_comm) = idxr
@ -240,20 +240,20 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,n,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd*n-1))
call igesd2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call igesd2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
! Then I receive
rcv_pt = brvidx(proc_to_comm)
call igerv2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call igerv2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
else if (proc_to_comm .gt. myrow) then
! First I receive
rcv_pt = brvidx(proc_to_comm)
call igerv2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call igerv2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
! Then I send
idx_pt = point_to_proc+nerv+psb_elem_send_
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,n,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd*n-1))
call igesd2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call igesd2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
else if (proc_to_comm .eq. myrow) then
! I send to myself
idx_pt = point_to_proc+nerv+psb_elem_send_
@ -297,7 +297,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
if(proc_to_comm.ne.myrow) then
p2ptag = krecvid(icontxt,proc_to_comm,myrow)
p2ptag = krecvid(ictxt,proc_to_comm,myrow)
rcv_pt = brvidx(proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),rvsz(proc_to_comm),&
& mpi_integer,prcid(proc_to_comm),&
@ -328,7 +328,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
& y,sndbuf(snd_pt:snd_pt+nesd*n-1))
if(proc_to_comm .ne. myrow) then
p2ptag=ksendid(icontxt,proc_to_comm,myrow)
p2ptag=ksendid(ictxt,proc_to_comm,myrow)
call mpi_send(sndbuf(snd_pt),sdsz(proc_to_comm),&
& mpi_integer,prcid(proc_to_comm),&
& p2ptag,icomm,iret)
@ -435,7 +435,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,n,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd*n-1))
call igesd2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call igesd2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
point_to_proc = point_to_proc+nerv+nesd+3
proc_to_comm = d_idx(point_to_proc+psb_proc_id_)
@ -451,7 +451,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
if(proc_to_comm.ne.myrow) then
rcv_pt = brvidx(proc_to_comm)
call igerv2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call igerv2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_sct(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
@ -484,7 +484,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -536,7 +536,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: icontxt, nprow, npcol, myrow,&
integer :: ictxt, nprow, npcol, myrow,&
& mycol, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
@ -593,8 +593,8 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
name='psi_dswap_datav'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,myrow,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,myrow,mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -606,7 +606,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
goto 9999
endif
call blacs_get(icontxt,10,icomm)
call blacs_get(ictxt,10,icomm)
allocate(sdsz(0:nprow-1), rvsz(0:nprow-1), bsdidx(0:nprow-1),&
@ -648,7 +648,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
nerv = d_idx(point_to_proc+psb_n_elem_recv_)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = blacs_pnum(icontxt,proc_to_comm,mycol)
prcid(proc_to_comm) = blacs_pnum(ictxt,proc_to_comm,mycol)
ptp(proc_to_comm) = point_to_proc
brvidx(proc_to_comm) = idxr
@ -735,20 +735,20 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd-1))
call igesd2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call igesd2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
! Then I receive
rcv_pt = brvidx(proc_to_comm)
call igerv2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call igerv2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
else if (proc_to_comm .gt. myrow) then
! First I receive
rcv_pt = brvidx(proc_to_comm)
call igerv2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call igerv2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
! Then I send
idx_pt = point_to_proc+nerv+psb_elem_send_
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd-1))
call igesd2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call igesd2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
else if (proc_to_comm .eq. myrow) then
! I send to myself
idx_pt = point_to_proc+nerv+psb_elem_send_
@ -792,7 +792,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
if(proc_to_comm.ne.myrow) then
p2ptag = krecvid(icontxt,proc_to_comm,myrow)
p2ptag = krecvid(ictxt,proc_to_comm,myrow)
rcv_pt = brvidx(proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),rvsz(proc_to_comm),&
& mpi_integer,prcid(proc_to_comm),&
@ -822,7 +822,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
& y,sndbuf(snd_pt:snd_pt+nesd-1))
if(proc_to_comm .ne. myrow) then
p2ptag=ksendid(icontxt,proc_to_comm,myrow)
p2ptag=ksendid(ictxt,proc_to_comm,myrow)
call mpi_send(sndbuf(snd_pt),sdsz(proc_to_comm),&
& mpi_integer,prcid(proc_to_comm),&
& p2ptag,icomm,iret)
@ -930,7 +930,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd-1))
call igesd2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call igesd2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
point_to_proc = point_to_proc+nerv+nesd+3
proc_to_comm = d_idx(point_to_proc+psb_proc_id_)
@ -946,7 +946,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
if(proc_to_comm.ne.myrow) then
rcv_pt = brvidx(proc_to_comm)
call igerv2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call igerv2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_sct(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
@ -979,7 +979,7 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

56
src/internals/psi_iswaptran.f90
Unescape Escape View File

@ -43,7 +43,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: icontxt, nprow, npcol, myrow,&
integer :: ictxt, nprow, npcol, myrow,&
& mycol, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
@ -100,8 +100,8 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
name='psi_dswaptranm'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,myrow,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,myrow,mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -113,7 +113,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
goto 9999
endif
call blacs_get(icontxt,10,icomm)
call blacs_get(ictxt,10,icomm)
allocate(sdsz(0:nprow-1), rvsz(0:nprow-1), bsdidx(0:nprow-1),&
& brvidx(0:nprow-1), rvhd(0:nprow-1), prcid(0:nprow-1),&
@ -153,7 +153,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
nerv = d_idx(point_to_proc+psb_n_elem_recv_)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = blacs_pnum(icontxt,proc_to_comm,mycol)
prcid(proc_to_comm) = blacs_pnum(ictxt,proc_to_comm,mycol)
ptp(proc_to_comm) = point_to_proc
brvidx(proc_to_comm) = idxr
@ -241,20 +241,20 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
call igesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call igesd2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
! Then I receive
snd_pt = brvidx(proc_to_comm)
call igerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call igerv2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
else if (proc_to_comm .gt. myrow) then
! First I receive
snd_pt = bsdidx(proc_to_comm)
call igerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call igerv2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
! Then I send
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
call igesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call igesd2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
else if (proc_to_comm .eq. myrow) then
! I send to myself
idx_pt = point_to_proc+psb_elem_recv_
@ -299,7 +299,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
if(proc_to_comm.ne.myrow) then
p2ptag = krecvid(icontxt,proc_to_comm,myrow)
p2ptag = krecvid(ictxt,proc_to_comm,myrow)
snd_pt = brvidx(proc_to_comm)
call mpi_irecv(sndbuf(rcv_pt),sdsz(proc_to_comm),&
& mpi_integer,prcid(proc_to_comm),&
@ -329,7 +329,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
if(proc_to_comm .ne. myrow) then
p2ptag=ksendid(icontxt,proc_to_comm,myrow)
p2ptag=ksendid(ictxt,proc_to_comm,myrow)
call mpi_send(rcvbuf(rcv_pt),rvsz(proc_to_comm),&
& mpi_integer,prcid(proc_to_comm),&
& p2ptag,icomm,iret)
@ -436,7 +436,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
call igesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call igesd2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
point_to_proc = point_to_proc+nerv+nesd+3
proc_to_comm = d_idx(point_to_proc+psb_proc_id_)
@ -452,7 +452,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
if(proc_to_comm.ne.myrow) then
snd_pt = bsdidx(proc_to_comm)
call igerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call igerv2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
idx_pt = point_to_proc+nerv+psb_elem_send_
call psi_sct(nesd,n,d_idx(idx_pt:idx_pt+nesd-1),&
& sndbuf(snd_pt:snd_pt+n*nesd-1),beta,y)
@ -484,7 +484,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -538,7 +538,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: icontxt, nprow, npcol, myrow,&
integer :: ictxt, nprow, npcol, myrow,&
& mycol, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
@ -595,8 +595,8 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
name='psi_dswaptranv'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,myrow,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,myrow,mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -608,7 +608,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
goto 9999
endif
call blacs_get(icontxt,10,icomm)
call blacs_get(ictxt,10,icomm)
allocate(sdsz(0:nprow-1), rvsz(0:nprow-1), bsdidx(0:nprow-1),&
& brvidx(0:nprow-1), rvhd(0:nprow-1), prcid(0:nprow-1),&
@ -649,7 +649,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
nerv = d_idx(point_to_proc+psb_n_elem_recv_)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = blacs_pnum(icontxt,proc_to_comm,mycol)
prcid(proc_to_comm) = blacs_pnum(ictxt,proc_to_comm,mycol)
ptp(proc_to_comm) = point_to_proc
brvidx(proc_to_comm) = idxr
@ -736,20 +736,20 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
call igesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call igesd2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
! Then I receive
snd_pt = brvidx(proc_to_comm)
call igerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call igerv2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
else if (proc_to_comm .gt. myrow) then
! First I receive
snd_pt = bsdidx(proc_to_comm)
call igerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call igerv2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
! Then I send
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
call igesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call igesd2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
else if (proc_to_comm .eq. myrow) then
! I send to myself
idx_pt = point_to_proc+psb_elem_recv_
@ -794,7 +794,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
if(proc_to_comm.ne.myrow) then
p2ptag = krecvid(icontxt,proc_to_comm,myrow)
p2ptag = krecvid(ictxt,proc_to_comm,myrow)
snd_pt = brvidx(proc_to_comm)
call mpi_irecv(sndbuf(snd_pt),sdsz(proc_to_comm),&
& mpi_integer,prcid(proc_to_comm),&
@ -824,7 +824,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
if(proc_to_comm .ne. myrow) then
p2ptag=ksendid(icontxt,proc_to_comm,myrow)
p2ptag=ksendid(ictxt,proc_to_comm,myrow)
call mpi_send(rcvbuf(rcv_pt),rvsz(proc_to_comm),&
& mpi_integer,prcid(proc_to_comm),&
& p2ptag,icomm,iret)
@ -931,7 +931,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
call igesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call igesd2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
point_to_proc = point_to_proc+nerv+nesd+3
proc_to_comm = d_idx(point_to_proc+psb_proc_id_)
@ -947,7 +947,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
if(proc_to_comm.ne.myrow) then
snd_pt = bsdidx(proc_to_comm)
call igerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call igerv2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_sct(nesd,d_idx(idx_pt:idx_pt+nesd-1),&
@ -980,7 +980,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

56
src/internals/psi_zswapdata.f90
Unescape Escape View File

@ -43,7 +43,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: icontxt, nprow, npcol, myrow,&
integer :: ictxt, nprow, npcol, myrow,&
& mycol, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
@ -115,8 +115,8 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
name='psi_zswap_data'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,myrow,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,myrow,mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -128,7 +128,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
goto 9999
endif
call blacs_get(icontxt,10,icomm)
call blacs_get(ictxt,10,icomm)
allocate(sdsz(0:nprow-1), rvsz(0:nprow-1), bsdidx(0:nprow-1),&
& brvidx(0:nprow-1), rvhd(0:nprow-1), prcid(0:nprow-1),&
@ -168,7 +168,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
nerv = d_idx(point_to_proc+psb_n_elem_recv_)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = blacs_pnum(icontxt,proc_to_comm,mycol)
prcid(proc_to_comm) = blacs_pnum(ictxt,proc_to_comm,mycol)
ptp(proc_to_comm) = point_to_proc
brvidx(proc_to_comm) = idxr
@ -256,20 +256,20 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,n,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd*n-1))
call zgesd2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call zgesd2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
! Then I receive
rcv_pt = brvidx(proc_to_comm)
call zgerv2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call zgerv2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
else if (proc_to_comm .gt. myrow) then
! First I receive
rcv_pt = brvidx(proc_to_comm)
call zgerv2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call zgerv2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
! Then I send
idx_pt = point_to_proc+nerv+psb_elem_send_
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,n,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd*n-1))
call zgesd2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call zgesd2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
else if (proc_to_comm .eq. myrow) then
! I send to myself
idx_pt = point_to_proc+nerv+psb_elem_send_
@ -313,7 +313,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
if(proc_to_comm.ne.myrow) then
p2ptag = krecvid(icontxt,proc_to_comm,myrow)
p2ptag = krecvid(ictxt,proc_to_comm,myrow)
rcv_pt = brvidx(proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),rvsz(proc_to_comm),&
& mpi_double_complex,prcid(proc_to_comm),&
@ -344,7 +344,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
& y,sndbuf(snd_pt:snd_pt+nesd*n-1))
if(proc_to_comm .ne. myrow) then
p2ptag=ksendid(icontxt,proc_to_comm,myrow)
p2ptag=ksendid(ictxt,proc_to_comm,myrow)
call mpi_send(sndbuf(snd_pt),sdsz(proc_to_comm),&
& mpi_double_complex,prcid(proc_to_comm),&
& p2ptag,icomm,iret)
@ -451,7 +451,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,n,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd*n-1))
call zgesd2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call zgesd2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
point_to_proc = point_to_proc+nerv+nesd+3
proc_to_comm = d_idx(point_to_proc+psb_proc_id_)
@ -467,7 +467,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
if(proc_to_comm.ne.myrow) then
rcv_pt = brvidx(proc_to_comm)
call zgerv2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call zgerv2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_sct(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
@ -500,7 +500,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -552,7 +552,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: icontxt, nprow, npcol, myrow,&
integer :: ictxt, nprow, npcol, myrow,&
& mycol, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
@ -625,8 +625,8 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
name='psi_zswap_datav'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,myrow,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,myrow,mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -638,7 +638,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
goto 9999
endif
call blacs_get(icontxt,10,icomm)
call blacs_get(ictxt,10,icomm)
allocate(sdsz(0:nprow-1), rvsz(0:nprow-1), bsdidx(0:nprow-1),&
@ -680,7 +680,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
nerv = d_idx(point_to_proc+psb_n_elem_recv_)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = blacs_pnum(icontxt,proc_to_comm,mycol)
prcid(proc_to_comm) = blacs_pnum(ictxt,proc_to_comm,mycol)
ptp(proc_to_comm) = point_to_proc
brvidx(proc_to_comm) = idxr
@ -767,20 +767,20 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd-1))
call zgesd2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call zgesd2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
! Then I receive
rcv_pt = brvidx(proc_to_comm)
call zgerv2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call zgerv2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
else if (proc_to_comm .gt. myrow) then
! First I receive
rcv_pt = brvidx(proc_to_comm)
call zgerv2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call zgerv2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
! Then I send
idx_pt = point_to_proc+nerv+psb_elem_send_
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd-1))
call zgesd2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call zgesd2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
else if (proc_to_comm .eq. myrow) then
! I send to myself
idx_pt = point_to_proc+nerv+psb_elem_send_
@ -824,7 +824,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
if(proc_to_comm.ne.myrow) then
p2ptag = krecvid(icontxt,proc_to_comm,myrow)
p2ptag = krecvid(ictxt,proc_to_comm,myrow)
rcv_pt = brvidx(proc_to_comm)
call mpi_irecv(rcvbuf(rcv_pt),rvsz(proc_to_comm),&
& mpi_double_complex,prcid(proc_to_comm),&
@ -854,7 +854,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
& y,sndbuf(snd_pt:snd_pt+nesd-1))
if(proc_to_comm .ne. myrow) then
p2ptag=ksendid(icontxt,proc_to_comm,myrow)
p2ptag=ksendid(ictxt,proc_to_comm,myrow)
call mpi_send(sndbuf(snd_pt),sdsz(proc_to_comm),&
& mpi_double_complex,prcid(proc_to_comm),&
& p2ptag,icomm,iret)
@ -962,7 +962,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
snd_pt = bsdidx(proc_to_comm)
call psi_gth(nesd,d_idx(idx_pt:idx_pt+nesd-1),&
& y,sndbuf(snd_pt:snd_pt+nesd-1))
call zgesd2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call zgesd2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
point_to_proc = point_to_proc+nerv+nesd+3
proc_to_comm = d_idx(point_to_proc+psb_proc_id_)
@ -978,7 +978,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
if(proc_to_comm.ne.myrow) then
rcv_pt = brvidx(proc_to_comm)
call zgerv2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call zgerv2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_sct(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
@ -1011,7 +1011,7 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

56
src/internals/psi_zswaptran.f90
Unescape Escape View File

@ -43,7 +43,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: icontxt, nprow, npcol, myrow,&
integer :: ictxt, nprow, npcol, myrow,&
& mycol, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
@ -116,8 +116,8 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
name='psi_zswaptranm'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,myrow,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,myrow,mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -129,7 +129,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
goto 9999
endif
call blacs_get(icontxt,10,icomm)
call blacs_get(ictxt,10,icomm)
allocate(sdsz(0:nprow-1), rvsz(0:nprow-1), bsdidx(0:nprow-1),&
& brvidx(0:nprow-1), rvhd(0:nprow-1), prcid(0:nprow-1),&
@ -169,7 +169,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
nerv = d_idx(point_to_proc+psb_n_elem_recv_)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = blacs_pnum(icontxt,proc_to_comm,mycol)
prcid(proc_to_comm) = blacs_pnum(ictxt,proc_to_comm,mycol)
ptp(proc_to_comm) = point_to_proc
brvidx(proc_to_comm) = idxr
@ -257,20 +257,20 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
call zgesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call zgesd2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
! Then I receive
snd_pt = brvidx(proc_to_comm)
call zgerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call zgerv2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
else if (proc_to_comm .gt. myrow) then
! First I receive
snd_pt = bsdidx(proc_to_comm)
call zgerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call zgerv2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
! Then I send
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
call zgesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call zgesd2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
else if (proc_to_comm .eq. myrow) then
! I send to myself
idx_pt = point_to_proc+psb_elem_recv_
@ -315,7 +315,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
if(proc_to_comm.ne.myrow) then
p2ptag = krecvid(icontxt,proc_to_comm,myrow)
p2ptag = krecvid(ictxt,proc_to_comm,myrow)
snd_pt = brvidx(proc_to_comm)
call mpi_irecv(sndbuf(rcv_pt),sdsz(proc_to_comm),&
& mpi_double_complex,prcid(proc_to_comm),&
@ -345,7 +345,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
if(proc_to_comm .ne. myrow) then
p2ptag=ksendid(icontxt,proc_to_comm,myrow)
p2ptag=ksendid(ictxt,proc_to_comm,myrow)
call mpi_send(rcvbuf(rcv_pt),rvsz(proc_to_comm),&
& mpi_double_complex,prcid(proc_to_comm),&
& p2ptag,icomm,iret)
@ -452,7 +452,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,n,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv*n-1))
call zgesd2d(icontxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call zgesd2d(ictxt,nerv,n,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
point_to_proc = point_to_proc+nerv+nesd+3
proc_to_comm = d_idx(point_to_proc+psb_proc_id_)
@ -468,7 +468,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
if(proc_to_comm.ne.myrow) then
snd_pt = bsdidx(proc_to_comm)
call zgerv2d(icontxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
call zgerv2d(ictxt,nesd,n,sndbuf(snd_pt),nesd,proc_to_comm,0)
idx_pt = point_to_proc+nerv+psb_elem_send_
call psi_sct(nesd,n,d_idx(idx_pt:idx_pt+nesd-1),&
& sndbuf(snd_pt:snd_pt+n*nesd-1),beta,y)
@ -500,7 +500,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -557,7 +557,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
integer, optional :: data
! locals
integer :: icontxt, nprow, npcol, myrow,&
integer :: ictxt, nprow, npcol, myrow,&
& mycol, point_to_proc, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, errlen, ifcomm, rank,&
@ -630,8 +630,8 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
name='psi_zswaptranv'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,myrow,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,myrow,mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -643,7 +643,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
goto 9999
endif
call blacs_get(icontxt,10,icomm)
call blacs_get(ictxt,10,icomm)
allocate(sdsz(0:nprow-1), rvsz(0:nprow-1), bsdidx(0:nprow-1),&
& brvidx(0:nprow-1), rvhd(0:nprow-1), prcid(0:nprow-1),&
@ -684,7 +684,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
nerv = d_idx(point_to_proc+psb_n_elem_recv_)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
prcid(proc_to_comm) = blacs_pnum(icontxt,proc_to_comm,mycol)
prcid(proc_to_comm) = blacs_pnum(ictxt,proc_to_comm,mycol)
ptp(proc_to_comm) = point_to_proc
brvidx(proc_to_comm) = idxr
@ -771,20 +771,20 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
call zgesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call zgesd2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
! Then I receive
snd_pt = brvidx(proc_to_comm)
call zgerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call zgerv2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
else if (proc_to_comm .gt. myrow) then
! First I receive
snd_pt = bsdidx(proc_to_comm)
call zgerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call zgerv2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
! Then I send
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
call zgesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call zgesd2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
else if (proc_to_comm .eq. myrow) then
! I send to myself
idx_pt = point_to_proc+psb_elem_recv_
@ -829,7 +829,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
nesd = d_idx(point_to_proc+nerv+psb_n_elem_send_)
if(proc_to_comm.ne.myrow) then
p2ptag = krecvid(icontxt,proc_to_comm,myrow)
p2ptag = krecvid(ictxt,proc_to_comm,myrow)
snd_pt = brvidx(proc_to_comm)
call mpi_irecv(sndbuf(snd_pt),sdsz(proc_to_comm),&
& mpi_double_complex,prcid(proc_to_comm),&
@ -859,7 +859,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
if(proc_to_comm .ne. myrow) then
p2ptag=ksendid(icontxt,proc_to_comm,myrow)
p2ptag=ksendid(ictxt,proc_to_comm,myrow)
call mpi_send(rcvbuf(rcv_pt),rvsz(proc_to_comm),&
& mpi_double_complex,prcid(proc_to_comm),&
& p2ptag,icomm,iret)
@ -966,7 +966,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
rcv_pt = brvidx(proc_to_comm)
call psi_gth(nerv,d_idx(idx_pt:idx_pt+nerv-1),&
& y,rcvbuf(rcv_pt:rcv_pt+nerv-1))
call zgesd2d(icontxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
call zgesd2d(ictxt,nerv,1,rcvbuf(rcv_pt),nerv,proc_to_comm,0)
point_to_proc = point_to_proc+nerv+nesd+3
proc_to_comm = d_idx(point_to_proc+psb_proc_id_)
@ -982,7 +982,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
if(proc_to_comm.ne.myrow) then
snd_pt = bsdidx(proc_to_comm)
call zgerv2d(icontxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
call zgerv2d(ictxt,nesd,1,sndbuf(snd_pt),nesd,proc_to_comm,0)
idx_pt = point_to_proc+psb_elem_recv_
rcv_pt = brvidx(proc_to_comm)
call psi_sct(nesd,d_idx(idx_pt:idx_pt+nesd-1),&
@ -1015,7 +1015,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

14
src/methd/extra_env.f90
Unescape Escape View File

@ -1,11 +1,11 @@
subroutine psb_set_coher(icontxt,isvch)
integer :: icontxt, isvch
subroutine psb_set_coher(ictxt,isvch)
integer :: ictxt, isvch
! Ensure global coherence for convergence checks.
Call blacs_get(icontxt,16,isvch)
Call blacs_set(icontxt,16,1)
Call blacs_get(ictxt,16,isvch)
Call blacs_set(ictxt,16,1)
end subroutine psb_set_coher
subroutine psb_restore_coher(icontxt,isvch)
integer :: icontxt, isvch
subroutine psb_restore_coher(ictxt,isvch)
integer :: ictxt, isvch
! Ensure global coherence for convergence checks.
Call blacs_set(icontxt,16,isvch)
Call blacs_set(ictxt,16,isvch)
end subroutine psb_restore_coher

14
src/methd/extra_env_essl.f90
Unescape Escape View File

@ -1,13 +1,13 @@
subroutine psb_set_coher(icontxt,isvch)
integer :: icontxt, isvch
subroutine psb_set_coher(ictxt,isvch)
integer :: ictxt, isvch
! Ensure global coherence for convergence checks.
! Do nothing: ESSL does coherence by default,
! and does not handle req=16
!!$ Call blacs_get(icontxt,16,isvch)
!!$ Call blacs_set(icontxt,16,1)
!!$ Call blacs_get(ictxt,16,isvch)
!!$ Call blacs_set(ictxt,16,1)
end subroutine psb_set_coher
subroutine psb_restore_coher(icontxt,isvch)
integer :: icontxt, isvch
subroutine psb_restore_coher(ictxt,isvch)
integer :: ictxt, isvch
! Ensure global coherence for convergence checks.
!!$ Call blacs_set(icontxt,16,isvch)
!!$ Call blacs_set(ictxt,16,isvch)
end subroutine psb_restore_coher

10
src/methd/psb_dbicg.f90
Unescape Escape View File

@ -108,7 +108,7 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
logical, parameter :: debug = .false.
logical, parameter :: exchange=.true., noexchange=.false.
integer, parameter :: irmax = 8
integer :: itx, i, isvch, ich, icontxt
integer :: itx, i, isvch, ich, ictxt
logical :: do_renum_left
real(kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,&
& sigma, omega, tau,bn2
@ -119,8 +119,8 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
call psb_erractionsave(err_act)
if (debug) write(*,*) 'entering psb_dbicg'
icontxt = desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprows,npcols,me,mecol)
ictxt = desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprows,npcols,me,mecol)
if (debug) write(*,*) 'psb_dbicg: from gridinfo',nprows,npcols,me
mglob = desc_a%matrix_data(psb_m_)
@ -128,7 +128,7 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
n_col = desc_a%matrix_data(psb_n_col_)
! Ensure global coherence for convergence checks.
call psb_set_coher(icontxt,isvch)
call psb_set_coher(ictxt,isvch)
if (present(istop)) then
@ -344,7 +344,7 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,&
call psb_gefree(wwrk,desc_a,info)
! restore external global coherence behaviour
call psb_restore_coher(icontxt,isvch)
call psb_restore_coher(ictxt,isvch)
if(info/=0) then
call psb_errpush(info,name)

10
src/methd/psb_dcg.f90
Unescape Escape View File

@ -103,7 +103,7 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
real(kind(1.d0)) ::alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,&
& sigma
integer :: litmax, liter, istop_, naux, m, mglob, it, itx, itrace_,&
& nprows,npcols,me,mecol, n_col, isvch, ich, icontxt, n_row,err_act, int_err(5)
& nprows,npcols,me,mecol, n_col, isvch, ich, ictxt, n_row,err_act, int_err(5)
character ::diagl, diagu
logical, parameter :: exchange=.true., noexchange=.false.
character(len=20) :: name,ch_err
@ -113,8 +113,8 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
call psb_erractionsave(err_act)
icontxt = desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprows,npcols,me,mecol)
ictxt = desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprows,npcols,me,mecol)
mglob = desc_a%matrix_data(psb_m_)
n_row = desc_a%matrix_data(psb_n_row_)
@ -178,7 +178,7 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
itx=0
! Ensure global coherence for convergence checks.
call psb_set_coher(icontxt,isvch)
call psb_set_coher(ictxt,isvch)
restart: do
!!$
@ -274,7 +274,7 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
call psb_gefree(wwrk,desc_a,info)
! restore external global coherence behaviour
call psb_restore_coher(icontxt,isvch)
call psb_restore_coher(ictxt,isvch)
if (info.ne.0) then
call psb_errpush(info,name)

10
src/methd/psb_dcgs.f90
Unescape Escape View File

@ -105,7 +105,7 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
Character ::diagl, diagu
Logical, Parameter :: exchange=.True., noexchange=.False.
Integer, Parameter :: irmax = 8
Integer :: itx, i, isvch, ich, icontxt
Integer :: itx, i, isvch, ich, ictxt
Logical :: do_renum_left
Logical, Parameter :: debug = .false.
Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,&
@ -117,8 +117,8 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
call psb_erractionsave(err_act)
If (debug) Write(*,*) 'entering psb_dcgs'
icontxt = desc_a%matrix_data(psb_ctxt_)
Call blacs_gridinfo(icontxt,nprows,npcols,me,mecol)
ictxt = desc_a%matrix_data(psb_ctxt_)
Call blacs_gridinfo(ictxt,nprows,npcols,me,mecol)
If (debug) Write(*,*) 'psb_dcgs: from gridinfo',nprows,npcols,me
mglob = desc_a%matrix_data(psb_m_)
@ -186,7 +186,7 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
End If
! Ensure global coherence for convergence checks.
call psb_set_coher(icontxt,isvch)
call psb_set_coher(ictxt,isvch)
diagl = 'u'
diagu = 'u'
@ -335,7 +335,7 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,&
Call psb_gefree(wwrk,desc_a,info)
! restore external global coherence behaviour
call psb_restore_coher(icontxt,isvch)
call psb_restore_coher(ictxt,isvch)
if(info/=0) then
call psb_errpush(info,name)

16
src/methd/psb_dcgstab.f90
Unescape Escape View File

@ -106,7 +106,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
Logical, Parameter :: debug = .false.
Logical, Parameter :: exchange=.True., noexchange=.False., debug1 = .False.
Integer, Parameter :: irmax = 8
Integer :: itx, i, isvch, ich, icontxt, err_act, int_err(5),ii
Integer :: itx, i, isvch, ich, ictxt, err_act, int_err(5),ii
Integer :: istop_
Logical :: do_renum_left
Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,&
@ -120,8 +120,8 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
call psb_erractionsave(err_act)
If (debug) Write(*,*) 'Entering PSB_DCGSTAB',present(istop)
icontxt = desc_a%matrix_data(psb_ctxt_)
CALL blacs_gridinfo(icontxt,nprows,npcols,myrow,mycol)
ictxt = desc_a%matrix_data(psb_ctxt_)
CALL blacs_gridinfo(ictxt,nprows,npcols,myrow,mycol)
if (debug) write(*,*) 'PSB_DCGSTAB: From GRIDINFO',nprows,npcols,myrow
mglob = desc_a%matrix_data(psb_m_)
@ -191,7 +191,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
diagu = 'U'
! Ensure global coherence for convergence checks.
call psb_set_coher(icontxt,isvch)
call psb_set_coher(ictxt,isvch)
itx = 0
@ -278,9 +278,9 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
If (debug) Write(*,*) 'Iteration: ',itx
rho_old = rho
rho = psb_gedot(q,r,desc_a,info)
!!$ call blacs_barrier(icontxt,'All') ! to be removed
!!$ call blacs_barrier(ictxt,'All') ! to be removed
!!$ write(0,'(i2," rho old ",2(f,2x))')myrow,rho,rho_old
!!$ call blacs_barrier(icontxt,'All') ! to be removed
!!$ call blacs_barrier(ictxt,'All') ! to be removed
If (rho==dzero) Then
If (debug) Write(0,*) 'Bi-CGSTAB Itxation breakdown R',rho
Exit iteration
@ -388,7 +388,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
Deallocate(aux)
Call psb_gefree(wwrk,desc_a,info)
! restore external global coherence behaviour
call psb_restore_coher(icontxt,isvch)
call psb_restore_coher(ictxt,isvch)
!!$ imerr = MPE_Log_event( istpe, 0, "ed CGSTAB" )
if(info/=0) then
call psb_errpush(info,name)
@ -401,7 +401,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

10
src/methd/psb_dcgstabl.f90
Unescape Escape View File

@ -114,7 +114,7 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
Character ::diagl, diagu
Logical, Parameter :: exchange=.True., noexchange=.False.
Integer, Parameter :: irmax = 8
Integer :: itx, i, isvch, ich, icontxt,istop_,j, int_err(5)
Integer :: itx, i, isvch, ich, ictxt,istop_,j, int_err(5)
Logical :: do_renum_left
Logical, Parameter :: debug = .False.
Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,&
@ -126,8 +126,8 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
call psb_erractionsave(err_act)
If (debug) Write(0,*) 'entering psb_dbicgstabl'
icontxt = desc_a%matrix_data(psb_ctxt_)
Call blacs_gridinfo(icontxt,nprows,npcols,me,mecol)
ictxt = desc_a%matrix_data(psb_ctxt_)
Call blacs_gridinfo(ictxt,nprows,npcols,me,mecol)
If (debug) Write(0,*) 'psb_dbicgstabl: from gridinfo',nprows,npcols,me
@ -207,7 +207,7 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
rt0 => wwrk(:,10)
! Ensure global coherence for convergence checks.
call psb_set_coher(icontxt,isvch)
call psb_set_coher(ictxt,isvch)
if (istop_ == 1) then
ani = psb_spnrmi(a,desc_a,info)
@ -394,7 +394,7 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,&
Call psb_gefree(rh,desc_a,info)
! restore external global coherence behaviour
call psb_restore_coher(icontxt,isvch)
call psb_restore_coher(ictxt,isvch)
if(info/=0) then
call psb_errpush(info,name)

10
src/methd/psb_dgmresr.f90
Unescape Escape View File

@ -116,7 +116,7 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
Character ::diagl, diagu
Logical, Parameter :: exchange=.True., noexchange=.False.
Integer, Parameter :: irmax = 8
Integer :: itx, i, isvch, ich, icontxt,istop_, err_act
Integer :: itx, i, isvch, ich, ictxt,istop_, err_act
Logical :: do_renum_left,inner_stop
Logical, Parameter :: debug = .false.
Real(Kind(1.d0)) :: alpha, beta, rho, rho_old, rni, xni, bni, ani,bn2,&
@ -129,8 +129,8 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
call psb_erractionsave(err_act)
If (debug) Write(0,*) 'entering psb_dgmres'
icontxt = desc_a%matrix_data(psb_ctxt_)
Call blacs_gridinfo(icontxt,nprows,npcols,me,mecol)
ictxt = desc_a%matrix_data(psb_ctxt_)
Call blacs_gridinfo(ictxt,nprows,npcols,me,mecol)
If (debug) Write(0,*) 'psb_dgmres: from gridinfo',nprows,npcols,me
@ -195,7 +195,7 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
&size(w),size(w,1), size(v(:,1))
! Ensure global coherence for convergence checks.
call psb_set_coher(icontxt,isvch)
call psb_set_coher(ictxt,isvch)
if (istop_ == 1) then
ani = psb_spnrmi(a,desc_a,info)
@ -338,7 +338,7 @@ Subroutine psb_dgmresr(a,prec,b,x,eps,desc_a,info,&
Call psb_gefree(w,desc_a,info)
! restore external global coherence behaviour
call psb_restore_coher(icontxt,isvch)
call psb_restore_coher(ictxt,isvch)
if (info /= 0) then
info=4011

10
src/methd/psb_zcgs.f90
Unescape Escape View File

@ -105,7 +105,7 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
Character ::diagl, diagu
Logical, Parameter :: exchange=.True., noexchange=.False.
Integer, Parameter :: irmax = 8
Integer :: itx, i, isvch, ich, icontxt
Integer :: itx, i, isvch, ich, ictxt
Logical :: do_renum_left
Logical, Parameter :: debug = .false.
Real(Kind(1.d0)) :: rni, xni, bni, ani,bn2
@ -117,8 +117,8 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
call psb_erractionsave(err_act)
If (debug) Write(*,*) 'entering psb_zcgs'
icontxt = desc_a%matrix_data(psb_ctxt_)
Call blacs_gridinfo(icontxt,nprows,npcols,me,mecol)
ictxt = desc_a%matrix_data(psb_ctxt_)
Call blacs_gridinfo(ictxt,nprows,npcols,me,mecol)
If (debug) Write(*,*) 'psb_zcgs: from gridinfo',nprows,npcols,me
mglob = desc_a%matrix_data(psb_m_)
@ -186,7 +186,7 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
End If
! Ensure global coherence for convergence checks.
call psb_set_coher(icontxt,isvch)
call psb_set_coher(ictxt,isvch)
diagl = 'u'
diagu = 'u'
@ -331,7 +331,7 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,&
Call psb_gefree(wwrk,desc_a,info)
! restore external global coherence behaviour
call psb_restore_coher(icontxt,isvch)
call psb_restore_coher(ictxt,isvch)
if(info/=0) then
call psb_errpush(info,name)

12
src/methd/psb_zcgstab.f90
Unescape Escape View File

@ -106,7 +106,7 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
Logical, Parameter :: debug = .false.
Logical, Parameter :: exchange=.True., noexchange=.False., debug1 = .False.
Integer, Parameter :: irmax = 8
Integer :: itx, i, isvch, ich, icontxt, err_act, int_err(5),ii
Integer :: itx, i, isvch, ich, ictxt, err_act, int_err(5),ii
Integer :: istop_
Logical :: do_renum_left
complex(Kind(1.d0)) :: alpha, beta, rho, rho_old, sigma, omega, tau
@ -120,8 +120,8 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
call psb_erractionsave(err_act)
If (debug) Write(*,*) 'Entering PSB_ZCGSTAB',present(istop)
icontxt = desc_a%matrix_data(psb_ctxt_)
CALL blacs_gridinfo(icontxt,nprows,npcols,myrow,mycol)
ictxt = desc_a%matrix_data(psb_ctxt_)
CALL blacs_gridinfo(ictxt,nprows,npcols,myrow,mycol)
if (debug) write(*,*) 'PSB_ZCGSTAB: From GRIDINFO',nprows,npcols,myrow
mglob = desc_a%matrix_data(psb_m_)
@ -182,7 +182,7 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
diagu = 'U'
! Ensure global coherence for convergence checks.
call psb_set_coher(icontxt,isvch)
call psb_set_coher(ictxt,isvch)
itx = 0
@ -373,7 +373,7 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
Call psb_gefree(wwrk,desc_a,info)
! restore external global coherence behaviour
call psb_restore_coher(icontxt,isvch)
call psb_restore_coher(ictxt,isvch)
!!$ imerr = MPE_Log_event( istpe, 0, "ed CGSTAB" )
if(info/=0) then
@ -387,7 +387,7 @@ Subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,&
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

12
src/modules/error.f90
Unescape Escape View File

@ -32,12 +32,12 @@
! Wrapper subroutines to provide error tools to F77 and C code
!
subroutine FCpsb_errcomm(icontxt, err)
subroutine FCpsb_errcomm(ictxt, err)
use psb_error_mod
integer, intent(in) :: icontxt
integer, intent(in) :: ictxt
integer, intent(inout):: err
call psb_errcomm(icontxt, err)
call psb_errcomm(ictxt, err)
end subroutine FCpsb_errcomm
@ -67,13 +67,13 @@ end subroutine FCpsb_serror
subroutine FCpsb_perror(icontxt)
subroutine FCpsb_perror(ictxt)
use psb_error_mod
implicit none
integer, intent(in) :: icontxt
integer, intent(in) :: ictxt
call psb_error(icontxt)
call psb_error(ictxt)
end subroutine FCpsb_perror

738
src/modules/psb_blacs_mod.f90
View File

File diff suppressed because it is too large Load Diff

20
src/modules/psb_error_mod.f90
Unescape Escape View File

@ -104,13 +104,13 @@ contains
! checks wether an error has occurred on one of the porecesses in the execution pool
subroutine psb_errcomm(icontxt, err)
integer, intent(in) :: icontxt
subroutine psb_errcomm(ictxt, err)
integer, intent(in) :: ictxt
integer, intent(inout):: err
integer :: temp(2)
integer, parameter :: ione=1
call igamx2d(icontxt, 'A', ' ', ione, ione, err, ione,&
call igamx2d(ictxt, 'A', ' ', ione, ione, err, ione,&
&temp ,temp,-ione ,-ione,-ione)
end subroutine psb_errcomm
@ -192,16 +192,16 @@ contains
! handles the occurence of an error in a parallel routine
subroutine psb_perror(icontxt)
subroutine psb_perror(ictxt)
integer, intent(in) :: icontxt
integer, intent(in) :: ictxt
integer :: err_c
character(len=20) :: r_name, a_e_d
integer :: i_e_d(5)
integer :: nprow, npcol, me, mypcol, temp(2)
integer, parameter :: ione=1, izero=0
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(ictxt, nprow, npcol, me, mypcol)
if(error_status.gt.0) then
if(verbosity_level.gt.1) then
@ -212,7 +212,7 @@ contains
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
! write(0,'(50("="))')
end do
call blacs_abort(icontxt,-1)
call blacs_abort(ictxt,-1)
else
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
@ -220,12 +220,12 @@ contains
do while (error_stack%n_elems.gt.0)
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
end do
call blacs_abort(icontxt,-1)
call blacs_abort(ictxt,-1)
end if
end if
if(error_status.gt.izero) then
call blacs_abort(icontxt,err_c)
call blacs_abort(ictxt,err_c)
end if
@ -384,6 +384,8 @@ contains
write (0,'("computational error. code: ",i0)')err_c
case(2010)
write (0,'("BLACS error. Number of processes=-1")')
case(2011)
write (0,'("Initialization error: not enough processes available in the parallel environment")')
case(2025)
write (0,'("Cannot allocate ",i0," bytes")')i_e_d(1)
case(2030)

39
src/modules/psb_tools_mod.f90
Unescape Escape View File

@ -358,16 +358,16 @@ Module psb_tools_mod
interface psb_cdall
subroutine psb_cdall(m, n, parts, icontxt, desc_a, info)
subroutine psb_cdall(m, n, parts, ictxt, desc_a, info)
use psb_descriptor_type
include 'parts.fh'
Integer, intent(in) :: m,n,icontxt
Integer, intent(in) :: m,n,ictxt
Type(psb_desc_type), intent(out) :: desc_a
integer, intent(out) :: info
end subroutine psb_cdall
subroutine psb_cdalv(m, v, icontxt, desc_a, info, flag)
subroutine psb_cdalv(m, v, ictxt, desc_a, info, flag)
use psb_descriptor_type
Integer, intent(in) :: m,icontxt, v(:)
Integer, intent(in) :: m,ictxt, v(:)
integer, intent(in), optional :: flag
integer, intent(out) :: info
Type(psb_desc_type), intent(out) :: desc_a
@ -615,22 +615,45 @@ Module psb_tools_mod
interface psb_cdrep
subroutine psb_cdrep(m, icontxt, desc_a,info)
subroutine psb_cdrep(m, ictxt, desc_a,info)
use psb_descriptor_type
Integer, intent(in) :: m,icontxt
Integer, intent(in) :: m,ictxt
Type(psb_desc_type), intent(out) :: desc_a
integer, intent(out) :: info
end subroutine psb_cdrep
end interface
interface psb_cddec
subroutine psb_cddec(nloc, icontxt, desc_a,info)
subroutine psb_cddec(nloc, ictxt, desc_a,info)
use psb_descriptor_type
Integer, intent(in) :: nloc,icontxt
Integer, intent(in) :: nloc,ictxt
Type(psb_desc_type), intent(out) :: desc_a
integer, intent(out) :: info
end subroutine psb_cddec
end interface
interface psb_init
subroutine psb_init(ictxt,np)
integer, intent(out) :: ictxt
integer, intent(in), optional :: np
end subroutine psb_init
end interface
interface psb_exit
subroutine psb_exit(ictxt)
integer, intent(in) :: ictxt
end subroutine psb_exit
end interface
interface psb_info
subroutine psb_info(ictxt,iam,np)
integer, intent(in) :: ictxt
integer, intent(out) :: iam, np
end subroutine psb_info
end interface
interface psb_barrier
subroutine psb_barrier(ictxt)
integer, intent(in) :: ictxt
end subroutine psb_barrier
end interface
end module psb_tools_mod

10
src/prec/psb_dasmatbld.f90
Unescape Escape View File

@ -79,7 +79,7 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
! .. Local Scalars ..
Integer :: k, tot_elem,proc,&
& point,nprow,npcol, me, mycol, start,m,nnzero,&
& icontxt, lovr, n_col, linp,ier,n,int_err(5),&
& ictxt, lovr, n_col, linp,ier,n,int_err(5),&
& tot_recv, ircode, n_row, nztot,nhalo, nrow_a,err_act
Logical,Parameter :: debug=.false., debugprt=.false.
character(len=20) :: name, ch_err
@ -89,7 +89,7 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
call psb_erractionsave(err_act)
If(debug) Write(0,*)'IN DASMATBLD ', upd
icontxt=desc_data%matrix_data(psb_ctxt_)
ictxt=desc_data%matrix_data(psb_ctxt_)
tot_recv=0
nrow_a = desc_data%matrix_data(psb_n_row_)
@ -133,7 +133,7 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
!
!
icontxt=desc_data%matrix_data(psb_ctxt_)
ictxt=desc_data%matrix_data(psb_ctxt_)
if (novr < 0) then
info=3
@ -171,9 +171,9 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
return
endif
call blacs_get(icontxt,10,icomm )
call blacs_get(ictxt,10,icomm )
Call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
Call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
If(debug)Write(0,*)'BEGIN dasmatbld',me,upd,novr
t1 = mpi_wtime()

6
src/prec/psb_dbaseprc_aply.f90
Unescape Escape View File

@ -60,7 +60,7 @@ subroutine psb_dbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info)
integer :: n_row,n_col, int_err(5)
real(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:)
character ::diagl, diagu
integer :: icontxt,nprow,npcol,me,mycol,i, isz, nrg, err_act
integer :: ictxt,nprow,npcol,me,mycol,i, isz, nrg, err_act
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime
@ -84,8 +84,8 @@ subroutine psb_dbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info)
info = 0
call psb_erractionsave(err_act)
icontxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
diagl='U'
diagu='U'

10
src/prec/psb_dbaseprc_bld.f90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
end interface
! Local scalars
Integer :: err, nnzero, n_row, n_col,I,j,k,icontxt,&
Integer :: err, nnzero, n_row, n_col,I,j,k,ictxt,&
& me,mycol,nprow,npcol,mglob,lw, mtype, nrg, nzg, err_act
real(kind(1.d0)) :: temp, real_err(5)
real(kind(1.d0)),pointer :: gd(:), work(:)
@ -130,12 +130,12 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
if (debug) write(0,*) 'Entering baseprc_bld'
info = 0
int_err(1) = 0
icontxt = desc_a%matrix_data(psb_ctxt_)
ictxt = desc_a%matrix_data(psb_ctxt_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call blacs_gridinfo(icontxt, nprow, npcol, me, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, me, mycol)
if (present(upd)) then
if (debug) write(0,*) 'UPD ', upd
@ -195,14 +195,14 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
& f_ilu_n_,is_legal_ml_fact)
if (debug) write(0,*)me, ': Calling PSB_ILU_BLD'
if (debug) call blacs_barrier(icontxt,'All')
if (debug) call blacs_barrier(ictxt,'All')
select case(p%iprcparm(f_type_))
case(f_ilu_n_,f_ilu_e_)
call psb_ilu_bld(a,desc_a,p,iupd,info)
if(debug) write(0,*)me,': out of psb_ilu_bld'
if (debug) call blacs_barrier(icontxt,'All')
if (debug) call blacs_barrier(ictxt,'All')
if(info /= 0) then
info=4010
ch_err='psb_ilu_bld'

6
src/prec/psb_dbjac_aply.f90
Unescape Escape View File

@ -62,7 +62,7 @@ subroutine psb_dbjac_aply(prec,x,beta,y,desc_data,trans,work,info)
integer :: n_row,n_col
real(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:),tb(:)
character ::diagl, diagu
integer :: icontxt,nprow,npcol,me,mycol,i, isz, nrg, err_act, int_err(5)
integer :: ictxt,nprow,npcol,me,mycol,i, isz, nrg, err_act, int_err(5)
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime
@ -72,8 +72,8 @@ subroutine psb_dbjac_aply(prec,x,beta,y,desc_data,trans,work,info)
info = 0
call psb_erractionsave(err_act)
icontxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
diagl='U'
diagu='U'

46
src/prec/psb_dbldaggrmat.f90
Unescape Escape View File

@ -52,15 +52,15 @@ subroutine psb_dbldaggrmat(a,desc_a,ac,p,desc_p,info)
integer, intent(out) :: info
logical, parameter :: aggr_dump=.false.
integer ::icontxt,nprow,npcol,me,mycol, err_act
integer ::ictxt,nprow,npcol,me,mycol, err_act
character(len=20) :: name, ch_err
name='psb_dbldaggrmat'
if(psb_get_errstatus().ne.0) return
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
select case (p%iprcparm(smth_kind_))
case (no_smth_)
@ -112,7 +112,7 @@ contains
type(psb_dspmat_type), pointer :: bg
type(psb_dspmat_type) :: b, tmp
integer, pointer :: nzbr(:), idisp(:)
integer :: icontxt, nrow, nglob, ncol, ntaggr, nzbg, ip, ndx,&
integer :: ictxt, nrow, nglob, ncol, ntaggr, nzbg, ip, ndx,&
& naggr, np, myprow, mypcol, nprows, npcols,nzt,irs,jl,nzl,nlr,&
& icomm,naggrm1, mtype, i, j, err_act
name='raw_aggregate'
@ -123,8 +123,8 @@ contains
bg => ac
call psb_nullify_sp(b)
icontxt = desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprows,npcols,myprow,mypcol)
ictxt = desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprows,npcols,myprow,mypcol)
np = nprows*npcols
nglob = desc_a%matrix_data(psb_m_)
nrow = desc_a%matrix_data(psb_n_row_)
@ -244,11 +244,11 @@ contains
if (p%iprcparm(coarse_mat_) == mat_repl_) then
call psb_cdrep(ntaggr,icontxt,desc_p,info)
call psb_cdrep(ntaggr,ictxt,desc_p,info)
nzbr(:) = 0
nzbr(myprow+1) = irs
call igsum2d(icontxt,'All',' ',np,1,nzbr,np,-1,-1)
call igsum2d(ictxt,'All',' ',np,1,nzbr,np,-1,-1)
nzbg = sum(nzbr)
call psb_sp_all(ntaggr,ntaggr,bg,nzbg,info)
if(info /= 0) then
@ -256,7 +256,7 @@ contains
goto 9999
end if
call blacs_get(icontxt,10,icomm )
call blacs_get(ictxt,10,icomm )
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo
@ -293,7 +293,7 @@ contains
else if (p%iprcparm(coarse_mat_) == mat_distr_) then
call psb_cddec(naggr,icontxt,desc_p,info)
call psb_cddec(naggr,ictxt,desc_p,info)
call psb_sp_clone(b,bg,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='spclone')
@ -342,7 +342,7 @@ contains
type(psb_dspmat_type), pointer :: bg
type(psb_dspmat_type) :: b
integer, pointer :: nzbr(:), idisp(:), ivall(:)
integer :: icontxt, nrow, nglob, ncol, ntaggr, nzbg, ip, ndx,&
integer :: ictxt, nrow, nglob, ncol, ntaggr, nzbg, ip, ndx,&
& naggr, np, myprow, mypcol, nprows, npcols,&
& icomm, naggrm1,naggrp1,mtype,i,j,err_act,k,nzl,itemp(1),jtemp(1)
type(psb_dspmat_type), pointer :: am1,am2
@ -360,8 +360,8 @@ contains
info=0
call psb_erractionsave(err_act)
icontxt = desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprows,npcols,myprow,mypcol)
ictxt = desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprows,npcols,myprow,mypcol)
bg => ac
call psb_nullify_sp(b)
@ -522,7 +522,7 @@ contains
anorm = max(anorm,tmp/dg)
enddo
call dgamx2d(icontxt,'All',' ',1,1,anorm,1,itemp,jtemp,-1,-1,-1)
call dgamx2d(ictxt,'All',' ',1,1,anorm,1,itemp,jtemp,-1,-1,-1)
else
anorm = psb_spnrmi(am3,desc_a,info)
endif
@ -730,7 +730,7 @@ contains
i = i + 1
end do
end do
call psb_cdall(ntaggr,ivall,icontxt,desc_p,info,flag=1)
call psb_cdall(ntaggr,ivall,ictxt,desc_p,info,flag=1)
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_cdall')
goto 9999
@ -804,7 +804,7 @@ contains
call psb_errpush(4010,name,a_err='psb_ipcoo2csr')
goto 9999
end if
call igsum2d(icontxt,'All',' ',1,1,k,1,-1,-1)
call igsum2d(ictxt,'All',' ',1,1,k,1,-1,-1)
if (k == 0) then
! If the off diagonal part is emtpy, there's no point
@ -852,15 +852,15 @@ contains
nzbr(:) = 0
nzbr(myprow+1) = b%infoa(psb_nnz_)
call psb_cdrep(ntaggr,icontxt,desc_p,info)
call psb_cdrep(ntaggr,ictxt,desc_p,info)
call igsum2d(icontxt,'All',' ',np,1,nzbr,np,-1,-1)
call igsum2d(ictxt,'All',' ',np,1,nzbr,np,-1,-1)
nzbg = sum(nzbr)
call psb_sp_all(ntaggr,ntaggr,bg,nzbg,info)
if(info /= 0) goto 9999
call blacs_get(icontxt,10,icomm )
call blacs_get(ictxt,10,icomm )
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo
@ -906,7 +906,7 @@ contains
call psb_errpush(4010,name,a_err='spclone')
goto 9999
end if
call psb_cddec(naggr,icontxt,desc_p,info)
call psb_cddec(naggr,ictxt,desc_p,info)
call psb_sp_free(b,info)
if(info /= 0) then
@ -921,10 +921,10 @@ contains
nzbr(:) = 0
nzbr(myprow+1) = b%infoa(psb_nnz_)
call psb_cdrep(ntaggr,icontxt,desc_p,info)
call psb_cdrep(ntaggr,ictxt,desc_p,info)
call igsum2d(icontxt,'All',' ',np,1,nzbr,np,-1,-1)
call igsum2d(ictxt,'All',' ',np,1,nzbr,np,-1,-1)
nzbg = sum(nzbr)
call psb_sp_all(ntaggr,ntaggr,bg,nzbg,info)
if(info /= 0) then
@ -932,7 +932,7 @@ contains
goto 9999
end if
call blacs_get(icontxt,10,icomm )
call blacs_get(ictxt,10,icomm )
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo

6
src/prec/psb_ddiagsc_bld.f90
Unescape Escape View File

@ -55,7 +55,7 @@ subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info)
! Local scalars
Integer :: err, nnzero, n_row, n_col,I,j,k,icontxt,&
Integer :: err, nnzero, n_row, n_col,I,j,k,ictxt,&
& me,mycol,nprow,npcol,mglob,lw, mtype, nrg, nzg, err_act
real(kind(1.d0)) :: temp, real_err(5)
real(kind(1.d0)),pointer :: gd(:), work(:)
@ -75,12 +75,12 @@ subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info)
if (debug) write(0,*) 'Entering diagsc_bld'
info = 0
int_err(1) = 0
icontxt = desc_a%matrix_data(psb_ctxt_)
ictxt = desc_a%matrix_data(psb_ctxt_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call blacs_gridinfo(icontxt, nprow, npcol, me, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, me, mycol)
if (debug) write(0,*) 'Precond: Diagonal scaling'
! diagonal scaling

8
src/prec/psb_dgenaggrmap.f90
Unescape Escape View File

@ -51,7 +51,7 @@ subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
logical :: recovery
logical, parameter :: debug=.false.
integer ::icontxt,nprow,npcol,me,mycol,err_act
integer ::ictxt,nprow,npcol,me,mycol,err_act
integer :: nrow, ncol, n_ne
integer, parameter :: one=1, two=2
character(len=20) :: name, ch_err
@ -65,8 +65,8 @@ subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
! so that we only have local decoupled aggregation. This might
! change in the future.
!
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
@ -279,7 +279,7 @@ subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
nlaggr(:) = 0
nlaggr(me+1) = naggr
call igsum2d(icontxt,'All',' ',nprow,1,nlaggr,nprow,-1,-1)
call igsum2d(ictxt,'All',' ',nprow,1,nlaggr,nprow,-1,-1)
call psb_erractionrestore(err_act)
return

24
src/prec/psb_dilu_bld.f90
Unescape Escape View File

@ -81,7 +81,7 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
integer istpb, istpe, ifctb, ifcte, err_act, irank, icomm, nztota, nztotb,&
& nztmp, nzl, nnr, ir, mglob, mtype, n_row, nrow_a,n_col, nhalo,lovr, &
& ind, iind, pi,nr,ns
integer ::icontxt,nprow,npcol,me,mycol
integer ::ictxt,nprow,npcol,me,mycol
character(len=20) :: name, ch_err
interface psb_ilu_fct
@ -132,8 +132,8 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
name='psb_ilu_bld'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
m = a%m
if (m < 0) then
@ -153,17 +153,17 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
goto 9999
endif
! call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
! call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
call psb_nullify_sp(blck)
call psb_nullify_sp(atmp)
t1= mpi_wtime()
if(debug) write(0,*)me,': calling psb_asmatbld',p%iprcparm(p_type_),p%iprcparm(n_ovr_)
if (debug) call blacs_barrier(icontxt,'All')
if (debug) call blacs_barrier(ictxt,'All')
call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
& blck,desc_a,upd,p%desc_data,info)
if(info/=0) then
@ -174,7 +174,7 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
end if
t2= mpi_wtime()
if (debug) write(0,*)me,': out of psb_asmatbld'
if (debug) call blacs_barrier(icontxt,'All')
if (debug) call blacs_barrier(ictxt,'All')
if (associated(p%av)) then
if (size(p%av) < bp_ilu_avsz) then
@ -195,7 +195,7 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
goto 9999
end if
if (debug) write(0,*)me,': out spinfo',nztota
if (debug) call blacs_barrier(icontxt,'All')
if (debug) call blacs_barrier(ictxt,'All')
n_col = desc_a%matrix_data(psb_n_col_)
nhalo = n_col-nrow_a
@ -231,7 +231,7 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
if (debug) then
write(0,*) me,'Done psb_asmatbld'
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
@ -264,7 +264,7 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
t3 = mpi_wtime()
if (debugprt) then
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
open(40+me)
call psb_csprt(40+me,atmp,head='% Local matrix')
close(40+me)
@ -301,7 +301,7 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
if (debugprt) then
open(40+me)
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
call psb_csprt(40+me,a,iv=p%desc_data%loc_to_glob,&
& head='% Local matrix')
if (p%iprcparm(p_type_)==asm_) then
@ -313,7 +313,7 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
t5= mpi_wtime()
if (debug) write(0,*) me,' Going for dilu_fct'
if (debug) call blacs_barrier(icontxt,'All')
if (debug) call blacs_barrier(ictxt,'All')
call psb_ilu_fct(a,p%av(l_pr_),p%av(u_pr_),p%d,info,blck=blck)
if(info/=0) then
info=4010

14
src/prec/psb_dmlprc_aply.f90
Unescape Escape View File

@ -63,7 +63,7 @@ subroutine psb_dmlprc_aply(baseprecv,x,beta,y,desc_data,trans,work,info)
real(kind(1.d0)), allocatable :: tx(:),ty(:),t2l(:),w2l(:),&
& x2l(:),b2l(:),tz(:),tty(:)
character ::diagl, diagu
integer :: icontxt,nprow,npcol,me,mycol,i, isz, nrg,nr2l,err_act, iptype, int_err(5)
integer :: ictxt,nprow,npcol,me,mycol,i, isz, nrg,nr2l,err_act, iptype, int_err(5)
real(kind(1.d0)) :: omega
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical, parameter :: debug=.false., debugprt=.false.
@ -90,8 +90,8 @@ subroutine psb_dmlprc_aply(baseprecv,x,beta,y,desc_data,trans,work,info)
call psb_erractionsave(err_act)
icontxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
omega=baseprecv(2)%dprcparm(smooth_omega_)
ismth=baseprecv(2)%iprcparm(smth_kind_)
@ -161,7 +161,7 @@ subroutine psb_dmlprc_aply(baseprecv,x,beta,y,desc_data,trans,work,info)
end if
if (baseprecv(2)%iprcparm(coarse_mat_)==mat_repl_) Then
call gsum2d(icontxt,'All',t2l(1:nrg))
call gsum2d(ictxt,'All',t2l(1:nrg))
else if (baseprecv(2)%iprcparm(coarse_mat_) /= mat_distr_) Then
write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ',&
& baseprecv(2)%iprcparm(coarse_mat_)
@ -264,7 +264,7 @@ subroutine psb_dmlprc_aply(baseprecv,x,beta,y,desc_data,trans,work,info)
end if
if (baseprecv(2)%iprcparm(coarse_mat_)==mat_repl_) Then
call gsum2d(icontxt,'All',t2l(1:nrg))
call gsum2d(ictxt,'All',t2l(1:nrg))
else if (baseprecv(2)%iprcparm(coarse_mat_) /= mat_distr_) Then
write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ',&
& baseprecv(2)%iprcparm(coarse_mat_)
@ -367,7 +367,7 @@ subroutine psb_dmlprc_aply(baseprecv,x,beta,y,desc_data,trans,work,info)
end if
if (baseprecv(2)%iprcparm(coarse_mat_)==mat_repl_) Then
call gsum2d(icontxt,'All',t2l(1:nrg))
call gsum2d(ictxt,'All',t2l(1:nrg))
else if (baseprecv(2)%iprcparm(coarse_mat_) /= mat_distr_) Then
write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ',&
& baseprecv(2)%iprcparm(coarse_mat_)
@ -458,7 +458,7 @@ subroutine psb_dmlprc_aply(baseprecv,x,beta,y,desc_data,trans,work,info)
if (baseprecv(2)%iprcparm(coarse_mat_)==mat_repl_) Then
call gsum2d(icontxt,'All',t2l(1:nrg))
call gsum2d(ictxt,'All',t2l(1:nrg))
else if (baseprecv(2)%iprcparm(coarse_mat_) /= mat_distr_) Then
write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ',&
& baseprecv(2)%iprcparm(coarse_mat_)

2
src/prec/psb_dmlprc_bld.f90
Unescape Escape View File

@ -96,7 +96,7 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
end subroutine psb_dbldaggrmat
end interface
integer :: icontxt, nprow, npcol, me, mycol
integer :: ictxt, nprow, npcol, me, mycol
name='psb_mlprec_bld'
if(psb_get_errstatus().ne.0) return

12
src/prec/psb_dprc_aply.f90
Unescape Escape View File

@ -54,7 +54,7 @@ subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work)
! Local variables
character :: trans_
real(kind(1.d0)), pointer :: work_(:)
integer :: icontxt,nprow,npcol,me,mycol,err_act, int_err(5)
integer :: ictxt,nprow,npcol,me,mycol,err_act, int_err(5)
logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime
character(len=20) :: name, ch_err
@ -91,8 +91,8 @@ subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work)
info = 0
call psb_erractionsave(err_act)
icontxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
if (present(trans)) then
trans_=trans
@ -218,7 +218,7 @@ subroutine psb_dprc_aply1(prec,x,desc_data,info,trans)
! Local variables
character :: trans_
integer :: icontxt,nprow,npcol,me,mycol,i, isz, err_act, int_err(5)
integer :: ictxt,nprow,npcol,me,mycol,i, isz, err_act, int_err(5)
real(kind(1.d0)), pointer :: WW(:), w1(:)
character(len=20) :: name, ch_err
name='psb_dprec1'
@ -226,8 +226,8 @@ subroutine psb_dprc_aply1(prec,x,desc_data,info,trans)
call psb_erractionsave(err_act)
icontxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
if (present(trans)) then
trans_=trans
else

6
src/prec/psb_dprecbld.f90
Unescape Escape View File

@ -82,7 +82,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
end interface
! Local scalars
Integer :: err, nnzero, I,j,k,icontxt,&
Integer :: err, nnzero, I,j,k,ictxt,&
& me,mycol,nprow,npcol,lw, mtype, nrg, nzg, err_act
real(kind(1.d0)) :: temp, real_err(5)
integer :: int_err(5)
@ -101,10 +101,10 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
if (debug) write(0,*) 'Entering precbld',P%prec,desc_a%matrix_data(:)
info = 0
int_err(1) = 0
icontxt = desc_a%matrix_data(psb_ctxt_)
ictxt = desc_a%matrix_data(psb_ctxt_)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call blacs_gridinfo(icontxt, nprow, npcol, me, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, me, mycol)
if (present(upd)) then
if (debug) write(0,*) 'UPD ', upd

2
src/prec/psb_dprecfree.f90
Unescape Escape View File

@ -52,7 +52,7 @@ subroutine psb_dprecfree(p,info)
integer :: int_err(5)
integer :: temp(1), me
real(kind(1.d0)) :: real_err(5)
integer :: icontxt,err_act,i
integer :: ictxt,err_act,i
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return

18
src/prec/psb_dslu_bld.f90
Unescape Escape View File

@ -51,7 +51,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
type(psb_dspmat_type) :: blck, atmp
character(len=5) :: fmt
character :: upd='F'
integer :: i,j,nza,nzb,nzt,icontxt, me,mycol,nprow,npcol,err_act
integer :: i,j,nza,nzb,nzt,ictxt, me,mycol,nprow,npcol,err_act
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
@ -76,8 +76,8 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
name='psb_slu_bld'
call psb_erractionsave(err_act)
icontxt = desc_A%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt, nprow, npcol, me, mycol)
ictxt = desc_A%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt, nprow, npcol, me, mycol)
fmt = 'COO'
@ -87,7 +87,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
atmp%fida='COO'
if (Debug) then
write(0,*) me, 'SPLUBLD: Calling csdp'
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
call psb_csdp(a,atmp,info)
@ -100,7 +100,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
nza = atmp%infoa(psb_nnz_)
if (Debug) then
write(0,*) me, 'SPLUBLD: Done csdp',info,nza,atmp%m,atmp%k
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
& blck,desc_a,upd,p%desc_data,info,outfmt=fmt)
@ -114,7 +114,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
nzb = blck%infoa(psb_nnz_)
if (Debug) then
write(0,*) me, 'SPLUBLD: Done asmatbld',info,nzb,blck%fida
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
if (nzb > 0 ) then
if (size(atmp%aspk)<nza+nzb) then
@ -128,7 +128,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
endif
if (Debug) then
write(0,*) me, 'SPLUBLD: Done realloc',info,nza+nzb,atmp%fida
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
do j=1,nzb
@ -174,7 +174,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
if (Debug) then
write(0,*) me,'Calling psb_slu_factor ',nzt,atmp%m,&
& atmp%k,p%desc_data%matrix_data(psb_n_row_)
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
call psb_dslu_factor(atmp%m,nzt,&
@ -188,7 +188,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
if (Debug) then
write(0,*) me, 'SPLUBLD: Done slu_Factor',info,p%iprcparm(slu_ptr_)
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
call psb_sp_free(blck,info)

10
src/prec/psb_dsp_renum.f90
Unescape Escape View File

@ -57,7 +57,7 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
integer istpb, istpe, ifctb, ifcte, err_act, irank, icomm, nztota, nztotb,&
& nztmp, nzl, nnr, ir, mglob, mtype, n_row, nrow_a,n_col, nhalo,lovr, &
& ind, iind, pi,nr,ns,i,j,jj,k,kk
integer ::icontxt,nprow,npcol,me,mycol
integer ::ictxt,nprow,npcol,me,mycol
integer, pointer :: itmp(:), itmp2(:)
real(kind(1.d0)), pointer :: rtmp(:)
real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,mpi_wtime, t7, t8
@ -68,8 +68,8 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
name='apply_renum'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
!!!!!!!!!!!!!!!! CHANGE FOR NON-CSR A
!
@ -245,7 +245,7 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
itmp(1:8) = 0
! write(0,*) me,' Renumbering: Calling Metis'
! call blacs_barrier(icontxt,'All')
! call blacs_barrier(ictxt,'All')
! write(0,*) size(p%av(u_pr_)%pl),size(p%av(l_pr_)%pr)
call gps_reduction(atmp%m,atmp%ia2,atmp%ia1,p%perm,p%invperm,info)
@ -257,7 +257,7 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
end if
! write(0,*) me,' Renumbering: Done GPS'
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
do i=1, atmp%m
if (p%perm(i) /= i) then
write(0,*) me,' permutation is not identity '

18
src/prec/psb_dumf_bld.f90
Unescape Escape View File

@ -51,7 +51,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
type(psb_dspmat_type) :: blck, atmp
character(len=5) :: fmt
character :: upd='F'
integer :: i,j,nza,nzb,nzt,icontxt, me,mycol,nprow,npcol,err_act
integer :: i,j,nza,nzb,nzt,ictxt, me,mycol,nprow,npcol,err_act
integer :: i_err(5)
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
@ -76,8 +76,8 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
name='psb_umf_bld'
call psb_erractionsave(err_act)
icontxt = desc_A%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt, nprow, npcol, me, mycol)
ictxt = desc_A%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt, nprow, npcol, me, mycol)
fmt = 'COO'
@ -87,7 +87,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
atmp%fida='COO'
if (Debug) then
write(0,*) me, 'UMFBLD: Calling csdp'
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
call psb_dcsdp(a,atmp,info)
@ -101,7 +101,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
if (Debug) then
call psb_spinfo(psb_nztotreq_,a,nzb,info)
write(0,*) me, 'UMFBLD: Done csdp',info,nza,atmp%m,atmp%k,nzb
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
& blck,desc_a,upd,p%desc_data,info,outfmt=fmt)
@ -115,7 +115,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
call psb_spinfo(psb_nztotreq_,blck,nzb,info)
if (Debug) then
write(0,*) me, 'UMFBLD: Done asmatbld',info,nzb,blck%fida
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
if (nzb > 0 ) then
if (size(atmp%aspk)<nza+nzb) then
@ -129,7 +129,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
endif
if (Debug) then
write(0,*) me, 'UMFBLD: Done realloc',info,nza+nzb,atmp%fida
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
do j=1,nzb
@ -178,7 +178,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
open(80+me)
call psb_csprt(80+me,atmp)
close(80+me)
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
call psb_dumf_factor(atmp%m,nzt,&
@ -194,7 +194,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
if (Debug) then
write(0,*) me, 'UMFBLD: Done umf_Factor',info,p%iprcparm(umf_numptr_)
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
call psb_sp_free(blck,info)
call psb_sp_free(atmp,info)

10
src/prec/psb_zasmatbld.f90
Unescape Escape View File

@ -79,7 +79,7 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
! .. Local Scalars ..
Integer :: k, tot_elem,proc,&
& point,nprow,npcol, me, mycol, start,m,nnzero,&
& icontxt, lovr, n_col, linp,ier,n,int_err(5),&
& ictxt, lovr, n_col, linp,ier,n,int_err(5),&
& tot_recv, ircode, n_row, nztot,nhalo, nrow_a,err_act
Logical,Parameter :: debug=.false., debugprt=.false.
character(len=20) :: name, ch_err
@ -89,7 +89,7 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
call psb_erractionsave(err_act)
If(debug) Write(0,*)'IN DASMATBLD ', upd
icontxt=desc_data%matrix_data(psb_ctxt_)
ictxt=desc_data%matrix_data(psb_ctxt_)
tot_recv=0
nrow_a = desc_data%matrix_data(psb_n_row_)
@ -133,7 +133,7 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
!
!
icontxt=desc_data%matrix_data(psb_ctxt_)
ictxt=desc_data%matrix_data(psb_ctxt_)
if (novr < 0) then
info=3
@ -171,9 +171,9 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
return
endif
call blacs_get(icontxt,10,icomm )
call blacs_get(ictxt,10,icomm )
Call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
Call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
If(debug)Write(0,*)'BEGIN dasmatbld',me,upd,novr
t1 = mpi_wtime()

6
src/prec/psb_zbaseprc_aply.f90
Unescape Escape View File

@ -60,7 +60,7 @@ subroutine psb_zbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info)
integer :: n_row,n_col, int_err(5)
complex(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:)
character ::diagl, diagu
integer :: icontxt,nprow,npcol,me,mycol,i, isz, nrg, err_act
integer :: ictxt,nprow,npcol,me,mycol,i, isz, nrg, err_act
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime
@ -84,8 +84,8 @@ subroutine psb_zbaseprc_aply(prec,x,beta,y,desc_data,trans,work,info)
info = 0
call psb_erractionsave(err_act)
icontxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
diagl='U'
diagu='U'

10
src/prec/psb_zbaseprc_bld.f90
Unescape Escape View File

@ -110,7 +110,7 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
end interface
! Local scalars
Integer :: err, nnzero, n_row, n_col,I,j,k,icontxt,&
Integer :: err, nnzero, n_row, n_col,I,j,k,ictxt,&
& me,mycol,nprow,npcol,mglob,lw, mtype, nrg, nzg, err_act
real(kind(1.d0)) :: temp, real_err(5)
real(kind(1.d0)),pointer :: gd(:), work(:)
@ -130,12 +130,12 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
if (debug) write(0,*) 'Entering baseprc_bld'
info = 0
int_err(1) = 0
icontxt = desc_a%matrix_data(psb_ctxt_)
ictxt = desc_a%matrix_data(psb_ctxt_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call blacs_gridinfo(icontxt, nprow, npcol, me, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, me, mycol)
if (present(upd)) then
if (debug) write(0,*) 'UPD ', upd
@ -195,14 +195,14 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
& f_ilu_n_,is_legal_ml_fact)
if (debug) write(0,*)me, ': Calling PSB_ILU_BLD'
if (debug) call blacs_barrier(icontxt,'All')
if (debug) call blacs_barrier(ictxt,'All')
select case(p%iprcparm(f_type_))
case(f_ilu_n_,f_ilu_e_)
call psb_ilu_bld(a,desc_a,p,iupd,info)
if(debug) write(0,*)me,': out of psb_ilu_bld'
if (debug) call blacs_barrier(icontxt,'All')
if (debug) call blacs_barrier(ictxt,'All')
if(info /= 0) then
info=4010
ch_err='psb_ilu_bld'

6
src/prec/psb_zbjac_aply.f90
Unescape Escape View File

@ -62,7 +62,7 @@ subroutine psb_zbjac_aply(prec,x,beta,y,desc_data,trans,work,info)
integer :: n_row,n_col
complex(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:),tb(:)
character ::diagl, diagu
integer :: icontxt,nprow,npcol,me,mycol,i, isz, nrg, err_act, int_err(5)
integer :: ictxt,nprow,npcol,me,mycol,i, isz, nrg, err_act, int_err(5)
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime
@ -72,8 +72,8 @@ subroutine psb_zbjac_aply(prec,x,beta,y,desc_data,trans,work,info)
info = 0
call psb_erractionsave(err_act)
icontxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
diagl='U'
diagu='U'

46
src/prec/psb_zbldaggrmat.f90
Unescape Escape View File

@ -52,15 +52,15 @@ subroutine psb_zbldaggrmat(a,desc_a,ac,p,desc_p,info)
integer, intent(out) :: info
logical, parameter :: aggr_dump=.false.
integer ::icontxt,nprow,npcol,me,mycol, err_act
integer ::ictxt,nprow,npcol,me,mycol, err_act
character(len=20) :: name, ch_err
name='psb_zbldaggrmat'
if(psb_get_errstatus().ne.0) return
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
select case (p%iprcparm(smth_kind_))
case (no_smth_)
@ -112,7 +112,7 @@ contains
type(psb_zspmat_type), pointer :: bg
type(psb_zspmat_type) :: b, tmp
integer, pointer :: nzbr(:), idisp(:)
integer :: icontxt, nrow, nglob, ncol, ntaggr, nzbg, ip, ndx,&
integer :: ictxt, nrow, nglob, ncol, ntaggr, nzbg, ip, ndx,&
& naggr, np, myprow, mypcol, nprows, npcols,nzt,irs,jl,nzl,nlr,&
& icomm,naggrm1, mtype, i, j, err_act
name='raw_aggregate'
@ -123,8 +123,8 @@ contains
bg => ac
call psb_nullify_sp(b)
icontxt = desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprows,npcols,myprow,mypcol)
ictxt = desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprows,npcols,myprow,mypcol)
np = nprows*npcols
nglob = desc_a%matrix_data(psb_m_)
nrow = desc_a%matrix_data(psb_n_row_)
@ -244,11 +244,11 @@ contains
if (p%iprcparm(coarse_mat_) == mat_repl_) then
call psb_cdrep(ntaggr,icontxt,desc_p,info)
call psb_cdrep(ntaggr,ictxt,desc_p,info)
nzbr(:) = 0
nzbr(myprow+1) = irs
call igsum2d(icontxt,'All',' ',np,1,nzbr,np,-1,-1)
call igsum2d(ictxt,'All',' ',np,1,nzbr,np,-1,-1)
nzbg = sum(nzbr)
call psb_sp_all(ntaggr,ntaggr,bg,nzbg,info)
if(info /= 0) then
@ -256,7 +256,7 @@ contains
goto 9999
end if
call blacs_get(icontxt,10,icomm )
call blacs_get(ictxt,10,icomm )
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo
@ -293,7 +293,7 @@ contains
else if (p%iprcparm(coarse_mat_) == mat_distr_) then
call psb_cddec(naggr,icontxt,desc_p,info)
call psb_cddec(naggr,ictxt,desc_p,info)
call psb_sp_clone(b,bg,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='spclone')
@ -342,7 +342,7 @@ contains
type(psb_zspmat_type), pointer :: bg
type(psb_zspmat_type) :: b
integer, pointer :: nzbr(:), idisp(:), ivall(:)
integer :: icontxt, nrow, nglob, ncol, ntaggr, nzbg, ip, ndx,&
integer :: ictxt, nrow, nglob, ncol, ntaggr, nzbg, ip, ndx,&
& naggr, np, myprow, mypcol, nprows, npcols,&
& icomm, naggrm1,naggrp1,mtype,i,j,err_act,k,nzl,itemp(1),jtemp(1)
type(psb_zspmat_type), pointer :: am1,am2
@ -360,8 +360,8 @@ contains
info=0
call psb_erractionsave(err_act)
icontxt = desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprows,npcols,myprow,mypcol)
ictxt = desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprows,npcols,myprow,mypcol)
bg => ac
call psb_nullify_sp(b)
@ -522,7 +522,7 @@ contains
anorm = max(anorm,tmp/dg)
enddo
call dgamx2d(icontxt,'All',' ',1,1,anorm,1,itemp,jtemp,-1,-1,-1)
call dgamx2d(ictxt,'All',' ',1,1,anorm,1,itemp,jtemp,-1,-1,-1)
else
anorm = psb_spnrmi(am3,desc_a,info)
endif
@ -730,7 +730,7 @@ contains
i = i + 1
end do
end do
call psb_cdall(ntaggr,ivall,icontxt,desc_p,info,flag=1)
call psb_cdall(ntaggr,ivall,ictxt,desc_p,info,flag=1)
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_cdall')
goto 9999
@ -804,7 +804,7 @@ contains
call psb_errpush(4010,name,a_err='psb_ipcoo2csr')
goto 9999
end if
call igsum2d(icontxt,'All',' ',1,1,k,1,-1,-1)
call igsum2d(ictxt,'All',' ',1,1,k,1,-1,-1)
if (k == 0) then
! If the off diagonal part is emtpy, there's no point
@ -852,15 +852,15 @@ contains
nzbr(:) = 0
nzbr(myprow+1) = b%infoa(psb_nnz_)
call psb_cdrep(ntaggr,icontxt,desc_p,info)
call psb_cdrep(ntaggr,ictxt,desc_p,info)
call igsum2d(icontxt,'All',' ',np,1,nzbr,np,-1,-1)
call igsum2d(ictxt,'All',' ',np,1,nzbr,np,-1,-1)
nzbg = sum(nzbr)
call psb_sp_all(ntaggr,ntaggr,bg,nzbg,info)
if(info /= 0) goto 9999
call blacs_get(icontxt,10,icomm )
call blacs_get(ictxt,10,icomm )
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo
@ -906,7 +906,7 @@ contains
call psb_errpush(4010,name,a_err='spclone')
goto 9999
end if
call psb_cddec(naggr,icontxt,desc_p,info)
call psb_cddec(naggr,ictxt,desc_p,info)
call psb_sp_free(b,info)
if(info /= 0) then
@ -921,10 +921,10 @@ contains
nzbr(:) = 0
nzbr(myprow+1) = b%infoa(psb_nnz_)
call psb_cdrep(ntaggr,icontxt,desc_p,info)
call psb_cdrep(ntaggr,ictxt,desc_p,info)
call igsum2d(icontxt,'All',' ',np,1,nzbr,np,-1,-1)
call igsum2d(ictxt,'All',' ',np,1,nzbr,np,-1,-1)
nzbg = sum(nzbr)
call psb_sp_all(ntaggr,ntaggr,bg,nzbg,info)
if(info /= 0) then
@ -932,7 +932,7 @@ contains
goto 9999
end if
call blacs_get(icontxt,10,icomm )
call blacs_get(ictxt,10,icomm )
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo

6
src/prec/psb_zdiagsc_bld.f90
Unescape Escape View File

@ -55,7 +55,7 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info)
! Local scalars
Integer :: err, nnzero, n_row, n_col,I,j,k,icontxt,&
Integer :: err, nnzero, n_row, n_col,I,j,k,ictxt,&
& me,mycol,nprow,npcol,mglob,lw, mtype, nrg, nzg, err_act
real(kind(1.d0)) :: temp, real_err(5)
complex(kind(1.d0)),pointer :: gd(:), work(:)
@ -75,12 +75,12 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info)
if (debug) write(0,*) 'Entering diagsc_bld'
info = 0
int_err(1) = 0
icontxt = desc_a%matrix_data(psb_ctxt_)
ictxt = desc_a%matrix_data(psb_ctxt_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
mglob = desc_a%matrix_data(psb_m_)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call blacs_gridinfo(icontxt, nprow, npcol, me, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, me, mycol)
if (debug) write(0,*) 'Precond: Diagonal scaling'
! diagonal scaling

8
src/prec/psb_zgenaggrmap.f90
Unescape Escape View File

@ -51,7 +51,7 @@ subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
logical :: recovery
logical, parameter :: debug=.false.
integer ::icontxt,nprow,npcol,me,mycol,err_act
integer ::ictxt,nprow,npcol,me,mycol,err_act
integer :: nrow, ncol, n_ne
integer, parameter :: one=1, two=2
character(len=20) :: name, ch_err
@ -65,8 +65,8 @@ subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
! so that we only have local decoupled aggregation. This might
! change in the future.
!
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_)
@ -279,7 +279,7 @@ subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
nlaggr(:) = 0
nlaggr(me+1) = naggr
call igsum2d(icontxt,'All',' ',nprow,1,nlaggr,nprow,-1,-1)
call igsum2d(ictxt,'All',' ',nprow,1,nlaggr,nprow,-1,-1)
call psb_erractionrestore(err_act)
return

24
src/prec/psb_zilu_bld.f90
Unescape Escape View File

@ -80,7 +80,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
integer istpb, istpe, ifctb, ifcte, err_act, irank, icomm, nztota, nztotb,&
& nztmp, nzl, nnr, ir, mglob, mtype, n_row, nrow_a,n_col, nhalo,lovr, &
& ind, iind, pi,nr,ns
integer ::icontxt,nprow,npcol,me,mycol
integer ::ictxt,nprow,npcol,me,mycol
character(len=20) :: name, ch_err
interface psb_ilu_fct
@ -131,8 +131,8 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
name='psb_ilu_bld'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
m = a%m
if (m < 0) then
@ -152,17 +152,17 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
goto 9999
endif
! call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
! call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
call psb_nullify_sp(blck)
call psb_nullify_sp(atmp)
t1= mpi_wtime()
if(debug) write(0,*)me,': calling psb_asmatbld',p%iprcparm(p_type_),p%iprcparm(n_ovr_)
if (debug) call blacs_barrier(icontxt,'All')
if (debug) call blacs_barrier(ictxt,'All')
call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
& blck,desc_a,upd,p%desc_data,info)
if(info/=0) then
@ -173,7 +173,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
end if
t2= mpi_wtime()
if (debug) write(0,*)me,': out of psb_asmatbld'
if (debug) call blacs_barrier(icontxt,'All')
if (debug) call blacs_barrier(ictxt,'All')
if (associated(p%av)) then
if (size(p%av) < bp_ilu_avsz) then
@ -194,7 +194,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
goto 9999
end if
if (debug) write(0,*)me,': out spinfo',nztota
if (debug) call blacs_barrier(icontxt,'All')
if (debug) call blacs_barrier(ictxt,'All')
n_col = desc_a%matrix_data(psb_n_col_)
nhalo = n_col-nrow_a
@ -230,7 +230,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
if (debug) then
write(0,*) me,'Done psb_asmatbld'
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
@ -263,7 +263,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
t3 = mpi_wtime()
if (debugprt) then
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
open(40+me)
call psb_csprt(40+me,atmp,head='% Local matrix')
close(40+me)
@ -300,7 +300,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
if (debugprt) then
open(40+me)
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
call psb_csprt(40+me,a,iv=p%desc_data%loc_to_glob,&
& head='% Local matrix')
if (p%iprcparm(p_type_)==asm_) then
@ -312,7 +312,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
t5= mpi_wtime()
if (debug) write(0,*) me,' Going for ilu_fct'
if (debug) call blacs_barrier(icontxt,'All')
if (debug) call blacs_barrier(ictxt,'All')
call psb_ilu_fct(a,p%av(l_pr_),p%av(u_pr_),p%d,info,blck=blck)
if(info/=0) then
info=4010

14
src/prec/psb_zmlprc_aply.f90
Unescape Escape View File

@ -63,7 +63,7 @@ subroutine psb_zmlprc_aply(baseprecv,x,beta,y,desc_data,trans,work,info)
complex(kind(1.d0)), allocatable :: tx(:),ty(:),t2l(:),w2l(:),&
& x2l(:),b2l(:),tz(:),tty(:)
character ::diagl, diagu
integer :: icontxt,nprow,npcol,me,mycol,i, isz, nrg,nr2l,err_act, iptype, int_err(5)
integer :: ictxt,nprow,npcol,me,mycol,i, isz, nrg,nr2l,err_act, iptype, int_err(5)
real(kind(1.d0)) :: omega
real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime
logical, parameter :: debug=.false., debugprt=.false.
@ -90,8 +90,8 @@ subroutine psb_zmlprc_aply(baseprecv,x,beta,y,desc_data,trans,work,info)
call psb_erractionsave(err_act)
icontxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
omega=baseprecv(2)%dprcparm(smooth_omega_)
ismth=baseprecv(2)%iprcparm(smth_kind_)
@ -161,7 +161,7 @@ subroutine psb_zmlprc_aply(baseprecv,x,beta,y,desc_data,trans,work,info)
end if
if (baseprecv(2)%iprcparm(coarse_mat_)==mat_repl_) Then
call gsum2d(icontxt,'All',t2l(1:nrg))
call gsum2d(ictxt,'All',t2l(1:nrg))
else if (baseprecv(2)%iprcparm(coarse_mat_) /= mat_distr_) Then
write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ',&
& baseprecv(2)%iprcparm(coarse_mat_)
@ -264,7 +264,7 @@ subroutine psb_zmlprc_aply(baseprecv,x,beta,y,desc_data,trans,work,info)
end if
if (baseprecv(2)%iprcparm(coarse_mat_)==mat_repl_) Then
call gsum2d(icontxt,'All',t2l(1:nrg))
call gsum2d(ictxt,'All',t2l(1:nrg))
else if (baseprecv(2)%iprcparm(coarse_mat_) /= mat_distr_) Then
write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ',&
& baseprecv(2)%iprcparm(coarse_mat_)
@ -367,7 +367,7 @@ subroutine psb_zmlprc_aply(baseprecv,x,beta,y,desc_data,trans,work,info)
end if
if (baseprecv(2)%iprcparm(coarse_mat_)==mat_repl_) Then
call gsum2d(icontxt,'All',t2l(1:nrg))
call gsum2d(ictxt,'All',t2l(1:nrg))
else if (baseprecv(2)%iprcparm(coarse_mat_) /= mat_distr_) Then
write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ',&
& baseprecv(2)%iprcparm(coarse_mat_)
@ -458,7 +458,7 @@ subroutine psb_zmlprc_aply(baseprecv,x,beta,y,desc_data,trans,work,info)
if (baseprecv(2)%iprcparm(coarse_mat_)==mat_repl_) Then
call gsum2d(icontxt,'All',t2l(1:nrg))
call gsum2d(ictxt,'All',t2l(1:nrg))
else if (baseprecv(2)%iprcparm(coarse_mat_) /= mat_distr_) Then
write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ',&
& baseprecv(2)%iprcparm(coarse_mat_)

2
src/prec/psb_zmlprc_bld.f90
Unescape Escape View File

@ -96,7 +96,7 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
end subroutine psb_zbldaggrmat
end interface
integer :: icontxt, nprow, npcol, me, mycol
integer :: ictxt, nprow, npcol, me, mycol
name='psb_mlprec_bld'
if(psb_get_errstatus().ne.0) return

12
src/prec/psb_zprc_aply.f90
Unescape Escape View File

@ -54,7 +54,7 @@ subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work)
! Local variables
character :: trans_
complex(kind(1.d0)), pointer :: work_(:)
integer :: icontxt,nprow,npcol,me,mycol,err_act, int_err(5)
integer :: ictxt,nprow,npcol,me,mycol,err_act, int_err(5)
logical,parameter :: debug=.false., debugprt=.false.
external mpi_wtime
character(len=20) :: name, ch_err
@ -91,8 +91,8 @@ subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work)
info = 0
call psb_erractionsave(err_act)
icontxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
if (present(trans)) then
trans_=trans
@ -218,7 +218,7 @@ subroutine psb_zprc_aply1(prec,x,desc_data,info,trans)
! Local variables
character :: trans_
integer :: icontxt,nprow,npcol,me,mycol,i, isz, err_act, int_err(5)
integer :: ictxt,nprow,npcol,me,mycol,i, isz, err_act, int_err(5)
complex(kind(1.d0)), pointer :: WW(:), w1(:)
character(len=20) :: name, ch_err
name='psb_zprec1'
@ -226,8 +226,8 @@ subroutine psb_zprc_aply1(prec,x,desc_data,info,trans)
call psb_erractionsave(err_act)
icontxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_data%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
if (present(trans)) then
trans_=trans
else

6
src/prec/psb_zprecbld.f90
Unescape Escape View File

@ -82,7 +82,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
end interface
! Local scalars
Integer :: err, nnzero, I,j,k,icontxt,&
Integer :: err, nnzero, I,j,k,ictxt,&
& me,mycol,nprow,npcol,lw, mtype, nrg, nzg, err_act
real(kind(1.d0)) :: temp, real_err(5)
integer :: int_err(5)
@ -101,10 +101,10 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
if (debug) write(0,*) 'Entering precbld',P%prec,desc_a%matrix_data(:)
info = 0
int_err(1) = 0
icontxt = desc_a%matrix_data(psb_ctxt_)
ictxt = desc_a%matrix_data(psb_ctxt_)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call blacs_gridinfo(icontxt, nprow, npcol, me, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, me, mycol)
if (present(upd)) then
if (debug) write(0,*) 'UPD ', upd

2
src/prec/psb_zprecfree.f90
Unescape Escape View File

@ -52,7 +52,7 @@ subroutine psb_zprecfree(p,info)
integer :: int_err(5)
integer :: temp(1), me
real(kind(1.d0)) :: real_err(5)
integer :: icontxt,err_act,i
integer :: ictxt,err_act,i
character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return

18
src/prec/psb_zslu_bld.f90
Unescape Escape View File

@ -51,7 +51,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
type(psb_zspmat_type) :: blck, atmp
character(len=5) :: fmt
character :: upd='F'
integer :: i,j,nza,nzb,nzt,icontxt, me,mycol,nprow,npcol,err_act
integer :: i,j,nza,nzb,nzt,ictxt, me,mycol,nprow,npcol,err_act
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
@ -76,8 +76,8 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
name='psb_slu_bld'
call psb_erractionsave(err_act)
icontxt = desc_A%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt, nprow, npcol, me, mycol)
ictxt = desc_A%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt, nprow, npcol, me, mycol)
fmt = 'COO'
@ -87,7 +87,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
atmp%fida='COO'
if (Debug) then
write(0,*) me, 'ZSLUBLD: Calling csdp'
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
call psb_csdp(a,atmp,info)
@ -100,7 +100,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
nza = atmp%infoa(psb_nnz_)
if (Debug) then
write(0,*) me, 'SPLUBLD: Done csdp',info,nza,atmp%m,atmp%k
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
& blck,desc_a,upd,p%desc_data,info,outfmt=fmt)
@ -114,7 +114,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
nzb = blck%infoa(psb_nnz_)
if (Debug) then
write(0,*) me, 'SPLUBLD: Done asmatbld',info,nzb,blck%fida
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
if (nzb > 0 ) then
if (size(atmp%aspk)<nza+nzb) then
@ -128,7 +128,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
endif
if (Debug) then
write(0,*) me, 'SPLUBLD: Done realloc',info,nza+nzb,atmp%fida
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
do j=1,nzb
@ -174,7 +174,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
if (Debug) then
write(0,*) me,'Calling psb_slu_factor ',nzt,atmp%m,&
& atmp%k,p%desc_data%matrix_data(psb_n_row_)
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
call psb_zslu_factor(atmp%m,nzt,&
@ -188,7 +188,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
if (Debug) then
write(0,*) me, 'SPLUBLD: Done slu_Factor',info,p%iprcparm(slu_ptr_)
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
call psb_sp_free(blck,info)

10
src/prec/psb_zsp_renum.f90
Unescape Escape View File

@ -57,7 +57,7 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info)
integer istpb, istpe, ifctb, ifcte, err_act, irank, icomm, nztota, nztotb,&
& nztmp, nzl, nnr, ir, mglob, mtype, n_row, nrow_a,n_col, nhalo,lovr, &
& ind, iind, pi,nr,ns,i,j,jj,k,kk
integer ::icontxt,nprow,npcol,me,mycol
integer ::ictxt,nprow,npcol,me,mycol
integer, pointer :: itmp(:), itmp2(:)
complex(kind(1.d0)), pointer :: ztmp(:)
real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,mpi_wtime, t7, t8
@ -68,8 +68,8 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info)
name='apply_renum'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt,nprow,npcol,me,mycol)
!!!!!!!!!!!!!!!! CHANGE FOR NON-CSR A
!
@ -245,7 +245,7 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info)
itmp(1:8) = 0
! write(0,*) me,' Renumbering: Calling Metis'
! call blacs_barrier(icontxt,'All')
! call blacs_barrier(ictxt,'All')
! write(0,*) size(p%av(u_pr_)%pl),size(p%av(l_pr_)%pr)
call gps_reduction(atmp%m,atmp%ia2,atmp%ia1,p%perm,p%invperm,info)
@ -257,7 +257,7 @@ subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info)
end if
! write(0,*) me,' Renumbering: Done GPS'
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
do i=1, atmp%m
if (p%perm(i) /= i) then
write(0,*) me,' permutation is not identity '

18
src/prec/psb_zumf_bld.f90
Unescape Escape View File

@ -51,7 +51,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
type(psb_zspmat_type) :: blck, atmp
character(len=5) :: fmt
character :: upd='F'
integer :: i,j,nza,nzb,nzt,icontxt, me,mycol,nprow,npcol,err_act
integer :: i,j,nza,nzb,nzt,ictxt, me,mycol,nprow,npcol,err_act
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
@ -75,8 +75,8 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
name='psb_umf_bld'
call psb_erractionsave(err_act)
icontxt = desc_A%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt, nprow, npcol, me, mycol)
ictxt = desc_A%matrix_data(psb_ctxt_)
call blacs_gridinfo(ictxt, nprow, npcol, me, mycol)
fmt = 'COO'
@ -86,7 +86,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
atmp%fida='COO'
if (Debug) then
write(0,*) me, 'UMFBLD: Calling csdp'
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
call psb_zcsdp(a,atmp,info)
@ -99,7 +99,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
call psb_spinfo(psb_nztotreq_,atmp,nza,info)
if (Debug) then
write(0,*) me, 'UMFBLD: Done csdp',info,nza,atmp%m,atmp%k
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
& blck,desc_a,upd,p%desc_data,info,outfmt=fmt)
@ -113,7 +113,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
call psb_spinfo(psb_nztotreq_,blck,nzb,info)
if (Debug) then
write(0,*) me, 'UMFBLD: Done asmatbld',info,nzb,blck%fida
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
if (nzb > 0 ) then
if (size(atmp%aspk)<nza+nzb) then
@ -127,7 +127,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
endif
if (Debug) then
write(0,*) me, 'UMFBLD: Done realloc',info,nza+nzb,atmp%fida
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
do j=1,nzb
@ -173,7 +173,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
if (Debug) then
write(0,*) me,'Calling psb_umf_factor ',nzt,atmp%m,&
& atmp%k,p%desc_data%matrix_data(psb_n_row_)
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
call psb_zumf_factor(atmp%m,nzt,&
@ -189,7 +189,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
if (Debug) then
write(0,*) me, 'UMFBLD: Done umf_Factor',info,p%iprcparm(umf_numptr_)
call blacs_barrier(icontxt,'All')
call blacs_barrier(ictxt,'All')
endif
call psb_sp_free(blck,info)
call psb_sp_free(atmp,info)

40
src/psblas/psb_damax.f90
Unescape Escape View File

@ -58,7 +58,7 @@ function psb_damax (x,desc_a, info, jx)
real(kind(1.d0)) :: psb_damax
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, m, i, k, imax, idamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
@ -70,10 +70,10 @@ function psb_damax (x,desc_a, info, jx)
amax=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -115,7 +115,7 @@ function psb_damax (x,desc_a, info, jx)
end if
! compute global max
call dgamx2d(icontxt, 'A', ' ', ione, ione, amax, ione,&
call dgamx2d(ictxt, 'A', ' ', ione, ione, amax, ione,&
&temp ,temp,-ione ,-ione,-ione)
psb_damax=amax
@ -127,7 +127,7 @@ function psb_damax (x,desc_a, info, jx)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -190,7 +190,7 @@ function psb_damaxv (x,desc_a, info)
real(kind(1.d0)) :: psb_damaxv
! locals
integer :: int_err(5), err, icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), err, ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, jx, temp(2), ix, ijx, m, imax, idamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
@ -202,10 +202,10 @@ function psb_damaxv (x,desc_a, info)
amax=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -243,7 +243,7 @@ function psb_damaxv (x,desc_a, info)
end if
! compute global max
call gamx2d(icontxt, 'A', amax)
call gamx2d(ictxt, 'A', amax)
psb_damaxv=amax
@ -254,7 +254,7 @@ function psb_damaxv (x,desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -319,7 +319,7 @@ subroutine psb_damaxvs (res,x,desc_a, info)
real(kind(1.D0)), intent(out) :: res
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, m, imax, idamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
@ -331,10 +331,10 @@ subroutine psb_damaxvs (res,x,desc_a, info)
amax=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -372,7 +372,7 @@ subroutine psb_damaxvs (res,x,desc_a, info)
end if
! compute global max
call gamx2d(icontxt, 'A', amax)
call gamx2d(ictxt, 'A', amax)
res = amax
@ -383,7 +383,7 @@ subroutine psb_damaxvs (res,x,desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -447,7 +447,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
real(kind(1.d0)), intent(out) :: res(:)
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, ix, temp(2), ijx, m, imax, i, k, idamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
@ -459,10 +459,10 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
amax=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -507,7 +507,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
end if
! compute global max
call gamx2d(icontxt, 'A', res(1:k))
call gamx2d(ictxt, 'A', res(1:k))
call psb_erractionrestore(err_act)
return
@ -516,7 +516,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

36
src/psblas/psb_dasum.f90
Unescape Escape View File

@ -59,7 +59,7 @@ function psb_dasum (x,desc_a, info, jx)
real(kind(1.d0)) :: psb_dasum
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, m, i
real(kind(1.d0)) :: asum, dasum
character(len=20) :: name, ch_err
@ -71,10 +71,10 @@ function psb_dasum (x,desc_a, info, jx)
asum=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -125,12 +125,12 @@ function psb_dasum (x,desc_a, info, jx)
end do
! compute global sum
call gsum2d(icontxt, 'A', asum)
call gsum2d(ictxt, 'A', asum)
else
asum=0.d0
! compute global sum
call gsum2d(icontxt, 'A', asum)
call gsum2d(ictxt, 'A', asum)
end if
else
asum=0.d0
@ -146,7 +146,7 @@ function psb_dasum (x,desc_a, info, jx)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -208,7 +208,7 @@ function psb_dasumv (x,desc_a, info)
real(kind(1.d0)) :: psb_dasumv
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), jx, ix, ijx, m, i
real(kind(1.d0)) :: asum, dasum
character(len=20) :: name, ch_err
@ -220,10 +220,10 @@ function psb_dasumv (x,desc_a, info)
asum=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -270,12 +270,12 @@ function psb_dasumv (x,desc_a, info)
end do
! compute global sum
call gsum2d(icontxt, 'A', asum)
call gsum2d(ictxt, 'A', asum)
else
asum=0.d0
! compute global sum
call gsum2d(icontxt, 'A', asum)
call gsum2d(ictxt, 'A', asum)
end if
else
asum=0.d0
@ -290,7 +290,7 @@ function psb_dasumv (x,desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -353,7 +353,7 @@ subroutine psb_dasumvs (res,x,desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, jx, ijx, m, i
real(kind(1.d0)) :: asum, dasum
character(len=20) :: name, ch_err
@ -365,10 +365,10 @@ subroutine psb_dasumvs (res,x,desc_a, info)
asum=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -415,12 +415,12 @@ subroutine psb_dasumvs (res,x,desc_a, info)
end do
! compute global sum
call gsum2d(icontxt, 'A',asum)
call gsum2d(ictxt, 'A',asum)
else
asum=0.d0
! compute global sum
call gsum2d(icontxt, 'A', asum)
call gsum2d(ictxt, 'A', asum)
end if
else
asum=0.d0
@ -436,7 +436,7 @@ subroutine psb_dasumvs (res,x,desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

16
src/psblas/psb_daxpby.f90
Unescape Escape View File

@ -64,7 +64,7 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
real(kind(1.D0)), intent(inout) :: y(:,:)
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, iix, jjx, temp(2), ix, iy, ijx, ijy, m, iiy, in, jjy
real(kind(1.d0)),pointer :: tmpx(:)
character(len=20) :: name, ch_err
@ -74,10 +74,10 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -ione) then
info = 2010
call psb_errpush(info,name)
@ -153,7 +153,7 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -221,7 +221,7 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
real(kind(1.D0)), intent(inout) :: y(:)
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, iy, ijx, m, iiy, in, jjy
character(len=20) :: name, ch_err
logical, parameter :: debug=.false.
@ -231,10 +231,10 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -ione) then
info = 2010
call psb_errpush(info,name)
@ -285,7 +285,7 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

40
src/psblas/psb_ddot.f90
Unescape Escape View File

@ -60,7 +60,7 @@ function psb_ddot(x, y,desc_a, info, jx, jy)
real(kind(1.D0)) :: psb_ddot
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
real(kind(1.D0)) :: dot_local
real(kind(1.d0)) :: ddot
@ -71,10 +71,10 @@ function psb_ddot(x, y,desc_a, info, jx, jy)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -ione) then
info = 2010
call psb_errpush(info,name)
@ -145,7 +145,7 @@ function psb_ddot(x, y,desc_a, info, jx, jy)
end if
! compute global sum
call dgsum2d(icontxt, 'A', ' ', ione, ione, dot_local,&
call dgsum2d(ictxt, 'A', ' ', ione, ione, dot_local,&
& ione, mone ,mycol)
psb_ddot = dot_local
@ -157,7 +157,7 @@ function psb_ddot(x, y,desc_a, info, jx, jy)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -219,7 +219,7 @@ function psb_ddotv(x, y,desc_a, info)
real(kind(1.D0)) :: psb_ddotv
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, jx, iy, jy, iiy, jjy, i, m, j, k
real(kind(1.D0)) :: dot_local
real(kind(1.d0)) :: ddot
@ -230,10 +230,10 @@ function psb_ddotv(x, y,desc_a, info)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -ione) then
info = 2010
call psb_errpush(info,name)
@ -288,7 +288,7 @@ function psb_ddotv(x, y,desc_a, info)
end if
! compute global sum
call dgsum2d(icontxt, 'A', ' ', ione, ione, dot_local,&
call dgsum2d(ictxt, 'A', ' ', ione, ione, dot_local,&
& ione, mone ,mycol)
psb_ddotv = dot_local
@ -300,7 +300,7 @@ function psb_ddotv(x, y,desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -362,7 +362,7 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
real(kind(1.D0)) :: dot_local
real(kind(1.d0)) :: ddot
@ -373,10 +373,10 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -ione) then
info = 2010
call psb_errpush(info,name)
@ -429,7 +429,7 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
end if
! compute global sum
call dgsum2d(icontxt, 'A', ' ', ione, ione, dot_local,&
call dgsum2d(ictxt, 'A', ' ', ione, ione, dot_local,&
& ione, mone ,mycol)
res = dot_local
@ -441,7 +441,7 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -508,7 +508,7 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
real(kind(1.d0)),allocatable :: dot_local(:)
real(kind(1.d0)) :: ddot
@ -519,10 +519,10 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -ione) then
info = 2010
call psb_errpush(info,name)
@ -587,7 +587,7 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
end if
! compute global sum
call dgsum2d(icontxt, 'A', ' ', ione, ione, dot_local,&
call dgsum2d(ictxt, 'A', ' ', ione, ione, dot_local,&
& ione, mone ,mycol)
res(1:k) = dot_local(1:k)
@ -599,7 +599,7 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

30
src/psblas/psb_dnrm2.f90
Unescape Escape View File

@ -56,7 +56,7 @@ function psb_dnrm2(x, desc_a, info, jx)
real(kind(1.D0)) :: psb_dnrm2
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ndim, ix, ijx, i, m, id
real(kind(1.d0)) :: nrm2, dnrm2, dd
real(kind(1.d0)),pointer :: tmpx(:)
@ -68,10 +68,10 @@ function psb_dnrm2(x, desc_a, info, jx)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -128,7 +128,7 @@ function psb_dnrm2(x, desc_a, info, jx)
nrm2 = dzero
end if
call pdtreecomb(icontxt,'All',1,nrm2,-1,-1,dcombnrm2)
call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
psb_dnrm2 = nrm2
@ -139,7 +139,7 @@ function psb_dnrm2(x, desc_a, info, jx)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -199,7 +199,7 @@ function psb_dnrm2v(x, desc_a, info)
real(kind(1.D0)) :: psb_dnrm2v
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ndim, ix, jx, ijx, i, m, id
real(kind(1.d0)) :: nrm2, dnrm2, dd
real(kind(1.d0)),pointer :: tmpx(:)
@ -211,10 +211,10 @@ function psb_dnrm2v(x, desc_a, info)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -268,7 +268,7 @@ function psb_dnrm2v(x, desc_a, info)
nrm2 = dzero
end if
call pdtreecomb(icontxt,'All',1,nrm2,-1,-1,dcombnrm2)
call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
psb_dnrm2v = nrm2
@ -279,7 +279,7 @@ function psb_dnrm2v(x, desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -341,7 +341,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ndim, ix, jx, ijx, i, m, id
real(kind(1.d0)) :: nrm2, dnrm2, dd
real(kind(1.d0)),pointer :: tmpx(:)
@ -353,10 +353,10 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -408,7 +408,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
nrm2 = dzero
end if
call pdtreecomb(icontxt,'All',1,nrm2,-1,-1,dcombnrm2)
call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
res = nrm2
@ -419,7 +419,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

10
src/psblas/psb_dnrmi.f90
Unescape Escape View File

@ -53,7 +53,7 @@ function psb_dnrmi(a,desc_a,info)
real(kind(1.d0)) :: psb_dnrmi
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iia, jja, ia, ja, temp(2), mdim, ndim, m
real(kind(1.d0)) :: nrmi, dcsnmi
character(len=20) :: name, ch_err
@ -63,10 +63,10 @@ function psb_dnrmi(a,desc_a,info)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -112,7 +112,7 @@ function psb_dnrmi(a,desc_a,info)
end if
! compute global max
call dgamx2d(icontxt, 'A', ' ', ione, ione, nrmi, ione,&
call dgamx2d(ictxt, 'A', ' ', ione, ione, nrmi, ione,&
&temp ,temp,-ione ,-ione,-ione)
else
nrmi = 0.d0
@ -127,7 +127,7 @@ function psb_dnrmi(a,desc_a,info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

16
src/psblas/psb_dspmm.f90
Unescape Escape View File

@ -101,7 +101,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: k, jx, jy,doswap
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), ix, iy, ik, ijx, ijy,&
& idoswap, m, nrow, ncol, lldx, lldy, liwork, llwork, iiy, jjy,&
& i, ib, ib1
@ -116,10 +116,10 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -355,7 +355,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -441,7 +441,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: doswap
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), ix, iy, ik, ijx, ijy,&
& idoswap, m, nrow, ncol, lldx, lldy, liwork, llwork, jx, jy, iiy, jjy,&
& i, ib, ib1
@ -456,10 +456,10 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -660,7 +660,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

16
src/psblas/psb_dspsm.f90
Unescape Escape View File

@ -97,7 +97,7 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: k, jx, jy
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,&
& ix, iy, ik, ijx, ijy, i, lld,&
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy
@ -114,10 +114,10 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -312,7 +312,7 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -403,7 +403,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: choice
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,&
& ix, iy, ik, jx, jy, i, lld,&
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy
@ -420,10 +420,10 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -606,7 +606,7 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

40
src/psblas/psb_zamax.f90
Unescape Escape View File

@ -58,7 +58,7 @@ function psb_zamax (x,desc_a, info, jx)
real(kind(1.d0)) :: psb_zamax
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, m, i, k, imax, izamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
@ -73,10 +73,10 @@ function psb_zamax (x,desc_a, info, jx)
amax=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -118,7 +118,7 @@ function psb_zamax (x,desc_a, info, jx)
end if
! compute global max
call gamx2d(icontxt, 'A', amax)
call gamx2d(ictxt, 'A', amax)
psb_zamax=amax
@ -129,7 +129,7 @@ function psb_zamax (x,desc_a, info, jx)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -192,7 +192,7 @@ function psb_zamaxv (x,desc_a, info)
real(kind(1.d0)) :: psb_zamaxv
! locals
integer :: int_err(5), err, icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), err, ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, jx, temp(2), ix, ijx, m, imax, izamax
real(kind(1.d0)) :: amax
complex(kind(1.d0)) :: cmax
@ -208,10 +208,10 @@ function psb_zamaxv (x,desc_a, info)
amax=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -250,7 +250,7 @@ function psb_zamaxv (x,desc_a, info)
end if
! compute global max
call gamx2d(icontxt, 'A', amax)
call gamx2d(ictxt, 'A', amax)
psb_zamaxv=amax
@ -261,7 +261,7 @@ function psb_zamaxv (x,desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -326,7 +326,7 @@ subroutine psb_zamaxvs (res,x,desc_a, info)
real(kind(1.D0)), intent(out) :: res
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, m, imax, izamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
@ -342,10 +342,10 @@ subroutine psb_zamaxvs (res,x,desc_a, info)
amax=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -384,7 +384,7 @@ subroutine psb_zamaxvs (res,x,desc_a, info)
end if
! compute global max
call gamx2d(icontxt, 'A', amax)
call gamx2d(ictxt, 'A', amax)
res = amax
@ -395,7 +395,7 @@ subroutine psb_zamaxvs (res,x,desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -459,7 +459,7 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx)
real(kind(1.d0)), intent(out) :: res(:)
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, ix, temp(2), ijx, m, imax, i, k, izamax
real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err
@ -475,10 +475,10 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx)
amax=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -524,7 +524,7 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx)
end if
! compute global max
call gamx2d(icontxt, 'A', res(1:k))
call gamx2d(ictxt, 'A', res(1:k))
call psb_erractionrestore(err_act)
return
@ -533,7 +533,7 @@ subroutine psb_zmamaxs (res,x,desc_a, info,jx)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

36
src/psblas/psb_zasum.f90
Unescape Escape View File

@ -59,7 +59,7 @@ function psb_zasum (x,desc_a, info, jx)
real(kind(1.d0)) :: psb_zasum
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, m, i
real(kind(1.d0)) :: asum, dzasum
character(len=20) :: name, ch_err
@ -75,10 +75,10 @@ function psb_zasum (x,desc_a, info, jx)
asum=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -130,12 +130,12 @@ function psb_zasum (x,desc_a, info, jx)
end do
! compute global sum
call gsum2d(icontxt, 'A', asum)
call gsum2d(ictxt, 'A', asum)
else
asum=0.d0
! compute global sum
call gsum2d(icontxt, 'A', asum)
call gsum2d(ictxt, 'A', asum)
end if
else
asum=0.d0
@ -151,7 +151,7 @@ function psb_zasum (x,desc_a, info, jx)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -213,7 +213,7 @@ function psb_zasumv (x,desc_a, info)
real(kind(1.d0)) :: psb_zasumv
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), jx, ix, ijx, m, i
real(kind(1.d0)) :: asum, dzasum
character(len=20) :: name, ch_err
@ -229,10 +229,10 @@ function psb_zasumv (x,desc_a, info)
asum=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -280,12 +280,12 @@ function psb_zasumv (x,desc_a, info)
end do
! compute global sum
call gsum2d(icontxt, 'A', asum)
call gsum2d(ictxt, 'A', asum)
else
asum=0.d0
! compute global sum
call gsum2d(icontxt, 'A', asum)
call gsum2d(ictxt, 'A', asum)
end if
else
asum=0.d0
@ -300,7 +300,7 @@ function psb_zasumv (x,desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -363,7 +363,7 @@ subroutine psb_zasumvs (res,x,desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, jx, ijx, m, i
real(kind(1.d0)) :: asum, dzasum
character(len=20) :: name, ch_err
@ -379,10 +379,10 @@ subroutine psb_zasumvs (res,x,desc_a, info)
asum=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -430,12 +430,12 @@ subroutine psb_zasumvs (res,x,desc_a, info)
end do
! compute global sum
call gsum2d(icontxt, 'A',asum)
call gsum2d(ictxt, 'A',asum)
else
asum=0.d0
! compute global sum
call gsum2d(icontxt, 'A', asum)
call gsum2d(ictxt, 'A', asum)
end if
else
asum=0.d0
@ -451,7 +451,7 @@ subroutine psb_zasumvs (res,x,desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

16
src/psblas/psb_zaxpby.f90
Unescape Escape View File

@ -64,7 +64,7 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
complex(kind(1.D0)), intent(inout) :: y(:,:)
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, iix, jjx, temp(2), ix, iy, ijx, ijy, m, iiy, in, jjy
character(len=20) :: name, ch_err
@ -73,10 +73,10 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -ione) then
info = 2010
call psb_errpush(info,name)
@ -152,7 +152,7 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -220,7 +220,7 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
complex(kind(1.D0)), intent(inout) :: y(:)
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, iy, ijx, m, iiy, in, jjy
character(len=20) :: name, ch_err
logical, parameter :: debug=.false.
@ -230,10 +230,10 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -ione) then
info = 2010
call psb_errpush(info,name)
@ -284,7 +284,7 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

40
src/psblas/psb_zdot.f90
Unescape Escape View File

@ -61,7 +61,7 @@ function psb_zdot(x, y,desc_a, info, jx, jy)
complex(kind(1.D0)) :: psb_zdot
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
complex(kind(1.D0)) :: dot_local
complex(kind(1.d0)) :: zdotc
@ -72,10 +72,10 @@ function psb_zdot(x, y,desc_a, info, jx, jy)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -ione) then
info = 2010
call psb_errpush(info,name)
@ -146,7 +146,7 @@ function psb_zdot(x, y,desc_a, info, jx, jy)
end if
! compute global sum
call gsum2d(icontxt, 'A', dot_local)
call gsum2d(ictxt, 'A', dot_local)
psb_zdot = dot_local
@ -157,7 +157,7 @@ function psb_zdot(x, y,desc_a, info, jx, jy)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -220,7 +220,7 @@ function psb_zdotv(x, y,desc_a, info)
complex(kind(1.D0)) :: psb_zdotv
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, jx, iy, jy, iiy, jjy, i, m, j, k
complex(kind(1.D0)) :: dot_local
complex(kind(1.d0)) :: zdotc
@ -231,10 +231,10 @@ function psb_zdotv(x, y,desc_a, info)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -ione) then
info = 2010
call psb_errpush(info,name)
@ -289,7 +289,7 @@ function psb_zdotv(x, y,desc_a, info)
end if
! compute global sum
call gsum2d(icontxt, 'A', dot_local)
call gsum2d(ictxt, 'A', dot_local)
psb_zdotv = dot_local
@ -300,7 +300,7 @@ function psb_zdotv(x, y,desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -363,7 +363,7 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
complex(kind(1.D0)) :: dot_local
complex(kind(1.d0)) :: zdotc
@ -374,10 +374,10 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -ione) then
info = 2010
call psb_errpush(info,name)
@ -430,7 +430,7 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
end if
! compute global sum
call gsum2d(icontxt, 'A', dot_local)
call gsum2d(ictxt, 'A', dot_local)
res = dot_local
@ -441,7 +441,7 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -509,7 +509,7 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, iy, ijy, iiy, jjy, i, m, j, k
complex(kind(1.d0)),allocatable :: dot_local(:)
complex(kind(1.d0)) :: zdotc
@ -520,10 +520,10 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -ione) then
info = 2010
call psb_errpush(info,name)
@ -588,7 +588,7 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
end if
! compute global sum
call gsum2d(icontxt, 'A', dot_local(1:k))
call gsum2d(ictxt, 'A', dot_local(1:k))
res(1:k) = dot_local(1:k)
@ -600,7 +600,7 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

30
src/psblas/psb_znrm2.f90
Unescape Escape View File

@ -56,7 +56,7 @@ function psb_znrm2(x, desc_a, info, jx)
real(kind(1.D0)) :: psb_znrm2
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ndim, ix, ijx, i, m, id
real(kind(1.d0)) :: nrm2, dznrm2, dd
@ -68,10 +68,10 @@ function psb_znrm2(x, desc_a, info, jx)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -127,7 +127,7 @@ function psb_znrm2(x, desc_a, info, jx)
nrm2 = dzero
end if
call pdtreecomb(icontxt,'All',1,nrm2,-1,-1,dcombnrm2)
call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
psb_znrm2 = nrm2
@ -138,7 +138,7 @@ function psb_znrm2(x, desc_a, info, jx)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -198,7 +198,7 @@ function psb_znrm2v(x, desc_a, info)
real(kind(1.D0)) :: psb_znrm2v
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ndim, ix, jx, ijx, i, m, id
real(kind(1.d0)) :: nrm2, dznrm2, dd
@ -210,10 +210,10 @@ function psb_znrm2v(x, desc_a, info)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -266,7 +266,7 @@ function psb_znrm2v(x, desc_a, info)
nrm2 = dzero
end if
call pdtreecomb(icontxt,'All',1,nrm2,-1,-1,dcombnrm2)
call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
psb_znrm2v = nrm2
@ -277,7 +277,7 @@ function psb_znrm2v(x, desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -339,7 +339,7 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
integer, intent(out) :: info
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ndim, ix, jx, ijx, i, m, id
real(kind(1.d0)) :: nrm2, dznrm2, dd
@ -351,10 +351,10 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -403,7 +403,7 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
nrm2 = dzero
end if
call pdtreecomb(icontxt,'All',1,nrm2,-1,-1,dcombnrm2)
call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
res = nrm2
@ -414,7 +414,7 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

10
src/psblas/psb_znrmi.f90
Unescape Escape View File

@ -54,7 +54,7 @@ function psb_znrmi(a,desc_a,info)
real(kind(1.d0)) :: psb_znrmi
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iia, jja, ia, ja, temp(2), mdim, ndim, m
real(kind(1.d0)) :: nrmi, zcsnmi
character(len=20) :: name, ch_err
@ -64,10 +64,10 @@ function psb_znrmi(a,desc_a,info)
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -113,7 +113,7 @@ function psb_znrmi(a,desc_a,info)
end if
! compute global max
call gamx2d(icontxt, 'A', nrmi)
call gamx2d(ictxt, 'A', nrmi)
else
nrmi = 0.d0
end if
@ -127,7 +127,7 @@ function psb_znrmi(a,desc_a,info)
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

16
src/psblas/psb_zspmm.f90
Unescape Escape View File

@ -100,7 +100,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: k, jx, jy,doswap
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), ix, iy, ik, ijx, ijy,&
& idoswap, m, nrow, ncol, lldx, lldy, liwork, llwork, iiy, jjy,&
& i, ib, ib1
@ -115,10 +115,10 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -350,7 +350,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -435,7 +435,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: doswap
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), ix, iy, ik, ijx, ijy,&
& idoswap, m, nrow, ncol, lldx, lldy, liwork, llwork, jx, jy, iiy, jjy,&
& i, ib, ib1
@ -450,10 +450,10 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -650,7 +650,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

16
src/psblas/psb_zspsm.f90
Unescape Escape View File

@ -96,7 +96,7 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: k, jx, jy
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,&
& ix, iy, ik, ijx, ijy, i, lld,&
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy
@ -113,10 +113,10 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -315,7 +315,7 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -406,7 +406,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
integer, intent(in), optional :: choice
! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
integer :: int_err(5), ictxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, ia, ja, iia, jja, temp(2), lldx,lldy, lchoice,&
& ix, iy, ik, jx, jy, i, lld,&
& idoswap, m, nrow, ncol, liwork, llwork, iiy, jjy
@ -423,10 +423,10 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
info=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -605,7 +605,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

3
src/tools/Makefile
Unescape Escape View File

@ -11,7 +11,8 @@ FOBJS = psb_dallc.o psb_dasb.o psb_dcsrp.o psb_cdprt.o \
psb_ifree.o psb_iins.o psb_loc_to_glob.o\
psb_zallc.o psb_zasb.o psb_zfree.o psb_zins.o \
psb_zspalloc.o psb_zspasb.o psb_zspcnv.o psb_zspfree.o\
psb_zspins.o psb_zsprn.o psb_zcdovr.o psb_zgelp.o
psb_zspins.o psb_zsprn.o psb_zcdovr.o psb_zgelp.o\
psb_init.o psb_exit.o psb_info.o psb_barrier.o
MPFOBJS = psb_dcdovrbld.o psb_dsphalo.o psb_zcdovrbld.o psb_zsphalo.o

6
src/tools/psb_barrier.f90
Unescape Escape View File

@ -0,0 +1,6 @@
subroutine psb_barrier(ictxt)
integer, intent(in) :: ictxt
call blacs_barrier(ictxt,'All')
end subroutine psb_barrier

18
src/tools/psb_cdall.f90
Unescape Escape View File

@ -38,10 +38,10 @@
! m - integer. The number of rows.
! n - integer. The number of columns.
! parts - external subroutine. The routine that contains the partitioning scheme.
! icontxt - integer. The communication context.
! ictxt - integer. The communication context.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
subroutine psb_cdall(m, n, parts, icontxt, desc_a, info)
subroutine psb_cdall(m, n, parts, ictxt, desc_a, info)
use psb_error_mod
use psb_descriptor_type
use psb_realloc_mod
@ -50,7 +50,7 @@ subroutine psb_cdall(m, n, parts, icontxt, desc_a, info)
implicit None
include 'parts.fh'
!....Parameters...
Integer, intent(in) :: M,N,ICONTXT
Integer, intent(in) :: M,N,ictxt
Type(psb_desc_type), intent(out) :: desc_a
integer, intent(out) :: info
@ -70,7 +70,7 @@ subroutine psb_cdall(m, n, parts, icontxt, desc_a, info)
name = 'psb_cdall'
call psb_erractionsave(err_act)
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (debug) write(*,*) 'psb_cdall: ',nprow,npcol,myrow,mycol
! ....verify blacs grid correctness..
if (npcol /= 1) then
@ -105,9 +105,9 @@ subroutine psb_cdall(m, n, parts, icontxt, desc_a, info)
if (myrow.eq.psb_root_) then
exch(1)=m
exch(2)=n
call igebs2d(icontxt,psb_all_,psb_topdef_, itwo,ione, exch, itwo)
call igebs2d(ictxt,psb_all_,psb_topdef_, itwo,ione, exch, itwo)
else
call igebr2d(icontxt,psb_all_,psb_topdef_, itwo,ione, exch, itwo, psb_root_,&
call igebr2d(ictxt,psb_all_,psb_topdef_, itwo,ione, exch, itwo, psb_root_,&
& 0)
if (exch(1) /= m) then
err=550
@ -314,8 +314,8 @@ subroutine psb_cdall(m, n, parts, icontxt, desc_a, info)
desc_a%matrix_data(psb_m_) = m
desc_a%matrix_data(psb_n_) = n
desc_a%matrix_data(psb_dec_type_) = psb_desc_bld_
desc_a%matrix_data(psb_ctxt_) = icontxt
call blacs_get(icontxt,10,desc_a%matrix_data(psb_mpi_c_))
desc_a%matrix_data(psb_ctxt_) = ictxt
call blacs_get(ictxt,10,desc_a%matrix_data(psb_mpi_c_))
call psb_erractionrestore(err_act)
return
@ -323,7 +323,7 @@ subroutine psb_cdall(m, n, parts, icontxt, desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

18
src/tools/psb_cdalv.f90
Unescape Escape View File

@ -37,18 +37,18 @@
! Parameters:
! m - integer. The number of rows.
! v - integer, dimension(:). The array containg the partitioning scheme.
! icontxt - integer. The communication context.
! ictxt - integer. The communication context.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code
! flag - integer. ???
subroutine psb_cdalv(m, v, icontxt, desc_a, info, flag)
subroutine psb_cdalv(m, v, ictxt, desc_a, info, flag)
use psb_descriptor_type
use psb_serial_mod
use psb_const_mod
use psb_error_mod
implicit None
!....Parameters...
Integer, intent(in) :: m,icontxt, v(:)
Integer, intent(in) :: m,ictxt, v(:)
integer, intent(in), optional :: flag
integer, intent(out) :: info
type(psb_desc_type), intent(out) :: desc_a
@ -68,7 +68,7 @@ subroutine psb_cdalv(m, v, icontxt, desc_a, info, flag)
err=0
name = 'psb_cdalv'
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (debug) write(*,*) 'psb_cdall: ',nprow,npcol,myrow,mycol
! ....verify blacs grid correctness..
if (npcol /= 1) then
@ -104,9 +104,9 @@ subroutine psb_cdalv(m, v, icontxt, desc_a, info, flag)
if (myrow.eq.psb_root_) then
exch(1)=m
exch(2)=n
call igebs2d(icontxt,psb_all_,psb_topdef_, itwo,ione, exch, itwo)
call igebs2d(ictxt,psb_all_,psb_topdef_, itwo,ione, exch, itwo)
else
call igebr2d(icontxt,psb_all_,psb_topdef_, itwo,ione, exch, itwo, psb_root_,&
call igebr2d(ictxt,psb_all_,psb_topdef_, itwo,ione, exch, itwo, psb_root_,&
& 0)
if (exch(1) /= m) then
info=550
@ -282,8 +282,8 @@ subroutine psb_cdalv(m, v, icontxt, desc_a, info, flag)
desc_a%matrix_data(psb_m_) = m
desc_a%matrix_data(psb_n_) = n
desc_a%matrix_data(psb_dec_type_) = psb_desc_bld_
desc_a%matrix_data(psb_ctxt_) = icontxt
call blacs_get(icontxt,10,desc_a%matrix_data(psb_mpi_c_))
desc_a%matrix_data(psb_ctxt_) = ictxt
call blacs_get(ictxt,10,desc_a%matrix_data(psb_mpi_c_))
call psb_erractionrestore(err_act)
return
@ -291,7 +291,7 @@ subroutine psb_cdalv(m, v, icontxt, desc_a, info, flag)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

10
src/tools/psb_cdasb.f90
Unescape Escape View File

@ -55,7 +55,7 @@ subroutine psb_cdasb(desc_a,info)
integer :: i,err,nprow,npcol,me,mypcol,&
& lovrlap,lhalo,nhalo,novrlap,max_size,max_halo,n_col,ldesc_halo,&
& ldesc_ovrlap, dectype, err_act
integer :: icontxt,temp(1),n_row
integer :: ictxt,temp(1),n_row
logical, parameter :: debug=.false., debugwrt=.false.
character(len=20) :: name,ch_err
@ -65,13 +65,13 @@ subroutine psb_cdasb(desc_a,info)
call psb_erractionsave(err_act)
icontxt = desc_a%matrix_data(psb_ctxt_)
ictxt = desc_a%matrix_data(psb_ctxt_)
dectype = desc_a%matrix_data(psb_dec_type_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(ictxt, nprow, npcol, me, mypcol)
if (nprow == -1) then
info = 2010
call psb_errpush(info,name)
@ -134,7 +134,7 @@ subroutine psb_cdasb(desc_a,info)
itemp(1) = max_size
itemp(2) = max_halo
call igamx2d(icontxt, psb_all_, psb_topdef_, itwo, ione, itemp,&
call igamx2d(ictxt, psb_all_, psb_topdef_, itwo, ione, itemp,&
& itwo,temp ,temp,-ione ,-ione,-ione)
max_size = itemp(1)
max_halo = itemp(2)
@ -224,7 +224,7 @@ subroutine psb_cdasb(desc_a,info)
if (err_act.eq.act_ret) then
return
else
call psb_error(icontxt)
call psb_error(ictxt)
end if
return

8
src/tools/psb_cdcpy.f90
Unescape Escape View File

@ -54,7 +54,7 @@ subroutine psb_cdcpy(desc_in, desc_out, info)
!locals
integer :: nprow,npcol,me,mypcol,&
& icontxt, isz, dectype, err_act, err
& ictxt, isz, dectype, err_act, err
integer :: int_err(5),temp(1)
real(kind(1.d0)) :: real_err(5)
logical, parameter :: debug=.false.,debugprt=.false.
@ -65,9 +65,9 @@ subroutine psb_cdcpy(desc_in, desc_out, info)
call psb_erractionsave(err_act)
name = 'psb_cdcpy'
icontxt=desc_in%matrix_data(psb_ctxt_)
ictxt=desc_in%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(ictxt, nprow, npcol, me, mypcol)
if (debug) write(0,*) me,'Entered CDCPY'
if (nprow.eq.-1) then
info = 2010
@ -234,7 +234,7 @@ subroutine psb_cdcpy(desc_in, desc_out, info)
if (err_act.eq.act_ret) then
return
else
call psb_error(icontxt)
call psb_error(ictxt)
end if
return

16
src/tools/psb_cddec.f90
Unescape Escape View File

@ -28,7 +28,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine psb_cddec(nloc, icontxt, desc_a, info)
subroutine psb_cddec(nloc, ictxt, desc_a, info)
! Purpose
! =======
@ -43,7 +43,7 @@ subroutine psb_cddec(nloc, icontxt, desc_a, info)
! Number of local indices
! required.
!
! ICONTXT : (Global Input)Integer BLACS context for an NPx1 grid
! ictxt : (Global Input)Integer BLACS context for an NPx1 grid
! required.
!
! OUTPUT
@ -109,7 +109,7 @@ subroutine psb_cddec(nloc, icontxt, desc_a, info)
use psb_error_mod
implicit None
!....Parameters...
Integer, intent(in) :: nloc,icontxt
Integer, intent(in) :: nloc,ictxt
integer, intent(out) :: info
Type(psb_desc_type), intent(out) :: desc_a
@ -129,7 +129,7 @@ subroutine psb_cddec(nloc, icontxt, desc_a, info)
err=0
name = 'psb_cddec'
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(ictxt, nprow, npcol, me, mypcol)
if (debug) write(*,*) 'psb_cdalll: ',nprow,npcol,me,mypcol
! ....verify blacs grid correctness..
if (npcol /= 1) then
@ -163,7 +163,7 @@ subroutine psb_cddec(nloc, icontxt, desc_a, info)
nlv(:) = 0
nlv(me) = nloc
call igsum2d(icontxt,'All',' ',nprow,1,nlv,nprow,-1,-1)
call igsum2d(ictxt,'All',' ',nprow,1,nlv,nprow,-1,-1)
m = sum(nlv)
@ -216,8 +216,8 @@ subroutine psb_cddec(nloc, icontxt, desc_a, info)
desc_a%matrix_data(psb_n_row_) = nloc
desc_a%matrix_data(psb_n_col_) = nloc
desc_a%matrix_data(psb_dec_type_) = psb_desc_asb_
desc_a%matrix_data(psb_ctxt_) = icontxt
call blacs_get(icontxt,10,desc_a%matrix_data(psb_mpi_c_))
desc_a%matrix_data(psb_ctxt_) = ictxt
call blacs_get(ictxt,10,desc_a%matrix_data(psb_mpi_c_))
call psb_erractionrestore(err_act)
return
@ -225,7 +225,7 @@ subroutine psb_cddec(nloc, icontxt, desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

8
src/tools/psb_cdfree.f90
Unescape Escape View File

@ -49,7 +49,7 @@ subroutine psb_cdfree(desc_a,info)
integer :: int_err(5)
integer :: temp(1)
real(kind(1.d0)) :: real_err(5)
integer :: icontxt,nprow,npcol,me,mypcol, err_act
integer :: ictxt,nprow,npcol,me,mypcol, err_act
character(len=20) :: name, char_err
if(psb_get_errstatus().ne.0) return
@ -64,9 +64,9 @@ subroutine psb_cdfree(desc_a,info)
return
end if
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
deallocate(desc_a%matrix_data)
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(ictxt, nprow, npcol, me, mypcol)
! ....verify blacs grid correctness..
if (nprow.eq.-1) then
info = 2010
@ -177,7 +177,7 @@ subroutine psb_cdfree(desc_a,info)
if (err_act.eq.act_ret) then
return
else
call psb_error(icontxt)
call psb_error(ictxt)
end if
return

8
src/tools/psb_cdins.f90
Unescape Escape View File

@ -54,7 +54,7 @@ subroutine psb_cdins(nz,ia,ja,desc_a,info)
!LOCALS.....
integer :: i,icontxt,nprocs ,glob_row,row,k,start_row,end_row,&
integer :: i,ictxt,nprocs ,glob_row,row,k,start_row,end_row,&
& first_loc_row,j, ierror,locix,locjx,&
& dectype,mglob, nnza, nglob,err
integer,pointer :: tia1(:),tia2(:), temp(:)
@ -68,7 +68,7 @@ subroutine psb_cdins(nz,ia,ja,desc_a,info)
name = 'psb_cdins'
call psb_erractionsave(err_act)
icontxt = desc_a%matrix_data(psb_ctxt_)
ictxt = desc_a%matrix_data(psb_ctxt_)
dectype = desc_a%matrix_data(psb_dec_type_)
mglob = desc_a%matrix_data(psb_m_)
nglob = desc_a%matrix_data(psb_n_)
@ -76,7 +76,7 @@ subroutine psb_cdins(nz,ia,ja,desc_a,info)
ncol = desc_a%matrix_data(psb_n_col_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(ictxt, nprow, npcol, me, mypcol)
if (npcol.ne.1) then
info = 2030
call psb_errpush(info,name)
@ -180,7 +180,7 @@ subroutine psb_cdins(nz,ia,ja,desc_a,info)
if (err_act.eq.act_ret) then
return
else
call psb_error(icontxt)
call psb_error(ictxt)
end if
return

10
src/tools/psb_cdren.f90
Unescape Escape View File

@ -60,7 +60,7 @@ subroutine psb_cdren(trans,iperm,desc_a,info)
!....locals....
integer :: i,j,err,nprow,npcol,myrow,mycol, n_col, kh, nh
integer :: dectype
integer :: icontxt,temp(1),n_row, int_err(5), err_act
integer :: ictxt,temp(1),n_row, int_err(5), err_act
real(kind(1.d0)) :: time(10), mpi_wtime, real_err(6)
external mpi_wtime
logical, parameter :: debug=.false.
@ -73,13 +73,13 @@ subroutine psb_cdren(trans,iperm,desc_a,info)
time(1) = mpi_wtime()
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
dectype=desc_a%matrix_data(psb_dec_type_)
n_row = desc_a%matrix_data(psb_n_row_)
n_col = desc_a%matrix_data(psb_n_col_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (nprow.eq.-1) then
info = 2010
call psb_errpush(info,name)
@ -213,7 +213,7 @@ subroutine psb_cdren(trans,iperm,desc_a,info)
time(4) = mpi_wtime()
time(4) = time(4) - time(3)
if (debug) then
call dgamx2d(icontxt, psb_all_, psb_topdef_, ione, ione, time(4),&
call dgamx2d(ictxt, psb_all_, psb_topdef_, ione, ione, time(4),&
& ione,temp ,temp,-ione ,-ione,-ione)
write (*, *) ' comm structs assembly: ', time(4)*1.d-3
@ -228,7 +228,7 @@ subroutine psb_cdren(trans,iperm,desc_a,info)
if (err_act.eq.act_ret) then
return
else
call psb_error(icontxt)
call psb_error(ictxt)
end if
return

18
src/tools/psb_cdrep.f90
Unescape Escape View File

@ -28,7 +28,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine psb_cdrep(m, icontxt, desc_a, info)
subroutine psb_cdrep(m, ictxt, desc_a, info)
! Purpose
! =======
@ -43,7 +43,7 @@ subroutine psb_cdrep(m, icontxt, desc_a, info)
! Total number of equations
! required.
!
! ICONTXT : (Global Input)Integer BLACS context for an NPx1 grid
! ictxt : (Global Input)Integer BLACS context for an NPx1 grid
! required.
!
! OUTPUT
@ -109,7 +109,7 @@ subroutine psb_cdrep(m, icontxt, desc_a, info)
use psb_error_mod
implicit None
!....Parameters...
Integer, intent(in) :: m,icontxt
Integer, intent(in) :: m,ictxt
integer, intent(out) :: info
Type(psb_desc_type), intent(out) :: desc_a
@ -128,7 +128,7 @@ subroutine psb_cdrep(m, icontxt, desc_a, info)
err=0
name = 'psb_cdrep'
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
if (debug) write(*,*) 'psb_cdrep: ',nprow,npcol,myrow,mycol
! ....verify blacs grid correctness..
if (npcol /= 1) then
@ -160,9 +160,9 @@ subroutine psb_cdrep(m, icontxt, desc_a, info)
if (myrow.eq.psb_root_) then
exch(1)=m
exch(2)=n
call igebs2d(icontxt,psb_all_,psb_topdef_, itwo,ione, exch, itwo)
call igebs2d(ictxt,psb_all_,psb_topdef_, itwo,ione, exch, itwo)
else
call igebr2d(icontxt,psb_all_,psb_topdef_, itwo,ione, exch, itwo, psb_root_,&
call igebr2d(ictxt,psb_all_,psb_topdef_, itwo,ione, exch, itwo, psb_root_,&
& 0)
if (exch(1) /= m) then
info=550
@ -212,8 +212,8 @@ subroutine psb_cdrep(m, icontxt, desc_a, info)
desc_a%matrix_data(psb_n_row_) = m
desc_a%matrix_data(psb_n_col_) = n
desc_a%matrix_data(psb_dec_type_) = psb_desc_repl_
desc_a%matrix_data(psb_ctxt_) = icontxt
call blacs_get(icontxt,10,desc_a%matrix_data(psb_mpi_c_))
desc_a%matrix_data(psb_ctxt_) = ictxt
call blacs_get(ictxt,10,desc_a%matrix_data(psb_mpi_c_))
call psb_erractionrestore(err_act)
return
@ -221,7 +221,7 @@ subroutine psb_cdrep(m, icontxt, desc_a, info)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

8
src/tools/psb_cdtransfer.f90
Unescape Escape View File

@ -54,7 +54,7 @@ subroutine psb_cdtransfer(desc_in, desc_out, info)
!locals
integer :: nprow,npcol,me,mypcol,&
& icontxt, isz, dectype, err_act, err
& ictxt, isz, dectype, err_act, err
integer :: int_err(5),temp(1)
real(kind(1.d0)) :: real_err(5)
logical, parameter :: debug=.false.,debugprt=.false.
@ -65,9 +65,9 @@ subroutine psb_cdtransfer(desc_in, desc_out, info)
call psb_erractionsave(err_act)
name = 'psb_cdtransfer'
icontxt=desc_in%matrix_data(psb_ctxt_)
ictxt=desc_in%matrix_data(psb_ctxt_)
! check on blacs grid
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(ictxt, nprow, npcol, me, mypcol)
if (debug) write(0,*) me,'Entered CDTRANSFER'
if (nprow.eq.-1) then
info = 2010
@ -103,7 +103,7 @@ subroutine psb_cdtransfer(desc_in, desc_out, info)
if (err_act.eq.act_ret) then
return
else
call psb_error(icontxt)
call psb_error(ictxt)
end if
return

20
src/tools/psb_dallc.f90
Unescape Escape View File

@ -56,7 +56,7 @@ subroutine psb_dalloc(x, desc_a, info, n)
!locals
integer :: nprow,npcol,myrow,mycol,err,n_col,n_row,i,j,jj,err_act
integer :: icontxt,dectype,n_
integer :: ictxt,dectype,n_
integer :: int_err(5),temp(1),exch(3)
real(kind(1.d0)) :: real_err(5)
character(len=20) :: name, ch_err
@ -68,9 +68,9 @@ subroutine psb_dalloc(x, desc_a, info, n)
int_err(1)=0
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
! ....verify blacs grid correctness..
if (nprow.eq.-1) then
info = 2010
@ -99,9 +99,9 @@ subroutine psb_dalloc(x, desc_a, info, n)
!global check on n parameters
if (myrow.eq.psb_root_) then
exch(1)=n_
call igebs2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione)
call igebs2d(ictxt,psb_all_,psb_topdef_, ione,ione, exch, ione)
else
call igebr2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione, psb_root_, 0)
call igebr2d(ictxt,psb_all_,psb_topdef_, ione,ione, exch, ione, psb_root_, 0)
if (exch(1).ne.n_) then
info=550
int_err(1)=1
@ -147,7 +147,7 @@ subroutine psb_dalloc(x, desc_a, info, n)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return
@ -209,7 +209,7 @@ subroutine psb_dallocv(x, desc_a,info,n)
!locals
integer :: nprow,npcol,myrow,mycol,err,n_col,n_row,dectype,i,err_act
integer :: icontxt, n_
integer :: ictxt, n_
integer :: int_err(5),temp(1),exch
real(kind(1.d0)) :: real_err(5)
logical, parameter :: debug=.false.
@ -220,9 +220,9 @@ subroutine psb_dallocv(x, desc_a,info,n)
name='psb_dallcv'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
call blacs_gridinfo(ictxt, nprow, npcol, myrow, mycol)
! ....verify blacs grid correctness..
if (nprow.eq.-1) then
info = 2010
@ -281,7 +281,7 @@ subroutine psb_dallocv(x, desc_a,info,n)
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.act_abort) then
call psb_error(icontxt)
call psb_error(ictxt)
return
end if
return

18
src/tools/psb_dasb.f90
Unescape Escape View File

@ -51,7 +51,7 @@ subroutine psb_dasb(x, desc_a, info)
integer, intent(out) :: info
! local variables
integer :: err, icontxt,nprow,npcol,me,mypcol,temp,lwork,nrow,ncol, err_act
integer :: err, ictxt,nprow,npcol,me,mypcol,temp,lwork,nrow,ncol, err_act
integer :: int_err(5), i1sz, i2sz, dectype, i,j
double precision :: real_err(5)
real(kind(1.d0)),parameter :: one=1
@ -63,10 +63,10 @@ subroutine psb_dasb(x, desc_a, info)
name='psb_dasb'
call psb_erractionsave(err_act)
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
dectype=desc_a%matrix_data(psb_dec_type_)
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(ictxt, nprow, npcol, me, mypcol)
if ((.not.associated(desc_a%matrix_data))) then
info=3110
@ -95,7 +95,7 @@ subroutine psb_dasb(x, desc_a, info)
endif
! check size
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
nrow=desc_a%matrix_data(psb_n_row_)
ncol=desc_a%matrix_data(psb_n_col_)
i1sz = size(x,dim=1)
@ -129,7 +129,7 @@ subroutine psb_dasb(x, desc_a, info)
if (err_act.eq.act_ret) then
return
else
call psb_error(icontxt)
call psb_error(ictxt)
end if
return
@ -187,7 +187,7 @@ subroutine psb_dasbv(x, desc_a, info)
integer, intent(out) :: info
! local variables
integer :: err, icontxt,nprow,npcol,me,mypcol,temp,lwork
integer :: err, ictxt,nprow,npcol,me,mypcol,temp,lwork
integer :: int_err(5), i1sz,nrow,ncol, dectype, i, err_act
double precision :: real_err(5)
real(kind(1.d0)),parameter :: one=1
@ -198,10 +198,10 @@ subroutine psb_dasbv(x, desc_a, info)
int_err(1) = 0
name = 'psb_dasbv'
icontxt=desc_a%matrix_data(psb_ctxt_)
ictxt=desc_a%matrix_data(psb_ctxt_)
dectype=desc_a%matrix_data(psb_dec_type_)
call blacs_gridinfo(icontxt, nprow, npcol, me, mypcol)
call blacs_gridinfo(ictxt, nprow, npcol, me, mypcol)
! ....verify blacs grid correctness..
if (nprow.eq.-1) then
@ -252,7 +252,7 @@ subroutine psb_dasbv(x, desc_a, info)
if (err_act.eq.act_ret) then
return
else
call psb_error(icontxt)
call psb_error(ictxt)
end if
return

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

Write Preview
Loading…
Cancel
Save