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

Fixed in-line docs.

Browse Source
psblas3-type-indexed
Salvatore Filippone 17 years ago
parent 204a3250f4
commit 66e1169a2b
30 changed files with 347 additions and 296 deletions
Show Stats Download Patch File Download Diff File

2
base/tools/psb_cdfree.f90
Unescape Escape View File

@ -35,7 +35,7 @@
! !
! Parameters: ! Parameters:
! desc_a - type(<psb_desc_type>). The communication descriptor to be freed. ! desc_a - type(<psb_desc_type>). The communication descriptor to be freed.
! info - integer. Eventually returns an error code. ! info - integer. return code.
subroutine psb_cdfree(desc_a,info) subroutine psb_cdfree(desc_a,info)
!...free descriptor structure... !...free descriptor structure...
use psb_descriptor_type use psb_descriptor_type

4
base/tools/psb_cdtransfer.f90
Unescape Escape View File

@ -31,7 +31,9 @@
! File: psb_cdtransfer.f90 ! File: psb_cdtransfer.f90
! !
! Subroutine: psb_cdtransfer ! Subroutine: psb_cdtransfer
! Transfers data and allocation from in to out (just like MOVE_ALLOC). ! Transfers data and allocation from in to out; behaves like MOVE_ALLOC, i.e.
! the IN arg is empty (and deallocated) upon exit.
!
! !
! Parameters: ! Parameters:
! desc_in - type(<psb_desc_type>). The communication descriptor to be ! desc_in - type(<psb_desc_type>). The communication descriptor to be

11
base/tools/psb_dallc.f90
Unescape Escape View File

@ -32,12 +32,13 @@
! File: psb_dallc.f90 ! File: psb_dallc.f90
! !
! Function: psb_dalloc ! Function: psb_dalloc
! Allocates dense matrix for PSBLAS routines ! Allocates dense matrix for PSBLAS routines.
! The descriptor may be in either the build or assembled state.
! !
! Parameters: ! Parameters:
! x - the matrix to be allocated. ! x - the matrix to be allocated.
! desc_a - the communication descriptor. ! desc_a - the communication descriptor.
! info - possibly returns an error code ! info - Return code
! n - optional number of columns. ! n - optional number of columns.
subroutine psb_dalloc(x, desc_a, info, n) subroutine psb_dalloc(x, desc_a, info, n)
!....allocate dense matrix for psblas routines..... !....allocate dense matrix for psblas routines.....
@ -178,13 +179,15 @@ end subroutine psb_dalloc
!!$ !!$
!!$ !!$
! !
!
! Function: psb_dallocv ! Function: psb_dallocv
! Allocates dense matrix for PSBLAS routines ! Allocates dense matrix for PSBLAS routines.
! The descriptor may be in either the build or assembled state.
! !
! Parameters: ! Parameters:
! x - the matrix to be allocated. ! x - the matrix to be allocated.
! desc_a - the communication descriptor. ! desc_a - the communication descriptor.
! info - possibly returns an error code ! info - return code
subroutine psb_dallocv(x, desc_a,info,n) subroutine psb_dallocv(x, desc_a,info,n)
!....allocate sparse matrix structure for psblas routines..... !....allocate sparse matrix structure for psblas routines.....
use psb_descriptor_type use psb_descriptor_type

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

@ -31,12 +31,16 @@
! File: psb_dasb.f90 ! File: psb_dasb.f90
! !
! Subroutine: psb_dasb ! Subroutine: psb_dasb
! Assembles a dense matrix for PSBLAS routines ! Assembles a dense matrix for PSBLAS routines.
! Since the allocation may have been called with the desciptor
! in the build state we make sure that X has a number of rows
! allowing for the halo indices, reallocating if necessary.
! We also call the halo routine for good measure.
! !
! Parameters: ! Parameters:
! x - real,pointer(dim=2). The matrix to be assembled. ! x(:,:) - real,allocatable The matrix to be assembled.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. return code
subroutine psb_dasb(x, desc_a, info) subroutine psb_dasb(x, desc_a, info)
!....assembly dense matrix x ..... !....assembly dense matrix x .....
use psb_descriptor_type use psb_descriptor_type
@ -161,11 +165,15 @@ end subroutine psb_dasb
!!$ !!$
! Subroutine: psb_dasb ! Subroutine: psb_dasb
! Assembles a dense matrix for PSBLAS routines ! Assembles a dense matrix for PSBLAS routines
! Since the allocation may have been called with the desciptor
! in the build state we make sure that X has a number of rows
! allowing for the halo indices, reallocating if necessary.
! We also call the halo routine for good measure.
! !
! Parameters: ! Parameters:
! x - real,pointer(dim=1). The matrix to be assembled. ! x(:) - real,allocatable The matrix to be assembled.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. Return code
subroutine psb_dasbv(x, desc_a, info) subroutine psb_dasbv(x, desc_a, info)
!....assembly dense matrix x ..... !....assembly dense matrix x .....
use psb_descriptor_type use psb_descriptor_type

12
base/tools/psb_dfree.f90
Unescape Escape View File

@ -34,9 +34,9 @@
! frees a dense matrix structure ! frees a dense matrix structure
! !
! Parameters: ! Parameters:
! x - real, allocatable, dimension(:,:). The dense matrix to be freed. ! x(:,:) - real, allocatable The dense matrix to be freed.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
subroutine psb_dfree(x, desc_a, info) subroutine psb_dfree(x, desc_a, info)
!...free dense matrix structure... !...free dense matrix structure...
use psb_const_mod use psb_const_mod
@ -109,9 +109,9 @@ end subroutine psb_dfree
! frees a dense matrix structure ! frees a dense matrix structure
! !
! Parameters: ! Parameters:
! x - real, allocatable, dimension(:). The dense matrix to be freed. ! x():) - real, allocatable The dense matrix to be freed.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
subroutine psb_dfreev(x, desc_a, info) subroutine psb_dfreev(x, desc_a, info)
!...free dense matrix structure... !...free dense matrix structure...
use psb_const_mod use psb_const_mod

43
base/tools/psb_dins.f90
Unescape Escape View File

@ -29,16 +29,21 @@
!!$ !!$
!!$ !!$
! Subroutine: psb_dinsvi ! Subroutine: psb_dinsvi
! Insert dense submatrix to dense matrix. ! Insert dense submatrix to dense matrix. Note: the row indices in IRW
! are assumed to be in global numbering and are converted on the fly.
! Row indices not belonging to the current process are silently discarded.
! !
! Parameters: ! Parameters:
! m - integer. Number of rows of submatrix belonging to ! m - integer. Number of rows of submatrix belonging to
! val to be inserted. ! val to be inserted.
! irw - integer(:) Row indices of rows of val (global numbering) ! irw(:) - integer Row indices of rows of val (global numbering)
! val - real, dimension(:). The source dense submatrix. ! val(:) - real The source dense submatrix.
! x - real, dimension(:). The destination dense matrix. ! x(:) - real The destination dense matrix.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. return code
! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl) subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix ..... !....insert dense submatrix to dense matrix .....
use psb_const_mod use psb_const_mod
@ -74,11 +79,6 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_dinsvi' name = 'psb_dinsvi'
!!$ if (.not.allocated(desc_a%glob_to_loc)) then
!!$ info=3110
!!$ call psb_errpush(info,name)
!!$ return
!!$ end if
if ((.not.allocated(desc_a%matrix_data))) then if ((.not.allocated(desc_a%matrix_data))) then
int_err(1)=3110 int_err(1)=3110
call psb_errpush(info,name) call psb_errpush(info,name)
@ -214,15 +214,21 @@ end subroutine psb_dinsvi
!!$ !!$
!!$ !!$
! Subroutine: psb_dinsi ! Subroutine: psb_dinsi
! Insert dense submatrix to dense matrix. Note: the row indices in IRW
! are assumed to be in global numbering and are converted on the fly.
! Row indices not belonging to the current process are silently discarded.
! !
! Parameters: ! Parameters:
! m - integer. Number of rows of submatrix belonging to ! m - integer. Number of rows of submatrix belonging to
! val to be inserted. ! val to be inserted.
! irw - integer(:) Row indices of rows of val (global numbering) ! irw(:) - integer Row indices of rows of val (global numbering)
! val - real, dimension(:,:). The source dense submatrix. ! val(:,:) - real The source dense submatrix.
! x - real, dimension(:,:). The destination dense matrix. ! x(:,:) - real The destination dense matrix.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. return code
! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl) subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix ..... !....insert dense submatrix to dense matrix .....
use psb_descriptor_type use psb_descriptor_type
@ -259,11 +265,6 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_dinsi' name = 'psb_dinsi'
!!$ if (.not.allocated(desc_a%glob_to_loc)) then
!!$ info=3110
!!$ call psb_errpush(info,name)
!!$ return
!!$ end if
if ((.not.allocated(desc_a%matrix_data))) then if ((.not.allocated(desc_a%matrix_data))) then
int_err(1)=3110 int_err(1)=3110
call psb_errpush(info,name) call psb_errpush(info,name)

17
base/tools/psb_dspalloc.f90
Unescape Escape View File

@ -36,8 +36,9 @@
! Parameters: ! Parameters:
! a - type(<psb_dspmat_type>). The sparse matrix to be allocated. ! a - type(<psb_dspmat_type>). The sparse matrix to be allocated.
! desc_a - type(<psb_desc_type>). The communication descriptor to be updated. ! desc_a - type(<psb_desc_type>). The communication descriptor to be updated.
! info - integer. Possibly returns an error code. ! info - integer. Return code.
! nnz - integer(optional). The number of nonzeroes in the matrix. ! nnz - integer(optional). The number of nonzeroes in the matrix.
! (local, user estimate)
! !
subroutine psb_dspalloc(a, desc_a, info, nnz) subroutine psb_dspalloc(a, desc_a, info, nnz)
@ -57,7 +58,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
!locals !locals
integer :: ictxt, dectype integer :: ictxt, dectype
integer :: np,me,loc_row,& integer :: np,me,loc_row,loc_col,&
& length_ia1,length_ia2, err_act,m,n & length_ia1,length_ia2, err_act,m,n
integer :: int_err(5) integer :: int_err(5)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -79,14 +80,9 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
goto 9999 goto 9999
endif endif
!
! hmm, not a good idea, not all compilers can rely on any given
! value for non initialized pointers. let's avoid this,
! and just rely on documentation.
! check if psdalloc is already called for this matrix
! set fields in desc_a%matrix_data....
loc_row = psb_cd_get_local_rows(desc_a) loc_row = psb_cd_get_local_rows(desc_a)
loc_col = psb_cd_get_local_cols(desc_a)
m = psb_cd_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_cd_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
@ -102,14 +98,13 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
length_ia1=nnz length_ia1=nnz
length_ia2=nnz length_ia2=nnz
else else
length_ia1=max(1,4*loc_row) length_ia1=max(1,5*loc_row)
length_ia2=max(1,4*loc_row)
endif endif
if (debug) write(*,*) 'allocating size:',length_ia1 if (debug) write(*,*) 'allocating size:',length_ia1
!....allocate aspk, ia1, ia2..... !....allocate aspk, ia1, ia2.....
call psb_sp_all(loc_row,loc_row,a,length_ia1,info) call psb_sp_all(loc_row,loc_col,a,length_ia1,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='sp_all' ch_err='sp_all'

24
base/tools/psb_dspasb.f90
Unescape Escape View File

@ -31,19 +31,23 @@
! File: psb_dspasb.f90 ! File: psb_dspasb.f90
! !
! Subroutine: psb_dspasb ! Subroutine: psb_dspasb
! Assembly sparse matrix and set psblas communications ! Assemble sparse matrix
! structures.
! !
! Parameters: ! Parameters:
! a - type(<psb_dspmat_type>). The sparse matrix to be allocated. ! a - type(<psb_dspmat_type>). The sparse matrix to be allocated.
! desc_a - type(<psb_desc_type>). The communication descriptor to be updated. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code. ! info - integer. return code.
! afmt - character,dimension(5)(optional). The output format. ! afmt - character(optional) The desired output storage format.
! up - character(optional). ??? ! upd - character(optional). How will the matrix be updated?
! dup - integer(optional). ??? ! psb_upd_srch_ Simple strategy
! psb_upd_perm_ Permutation(more memory)
! dupl - integer(optional). Duplicate coefficient handling:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
! psb_dupl_err_ raise an error.
!
! !
subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl) subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl)
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type use psb_spmat_type
use psb_serial_mod use psb_serial_mod
@ -113,7 +117,7 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl)
call psb_spcnv(a,info,afmt=afmt,upd=upd,dupl=dupl) call psb_spcnv(a,info,afmt=afmt,upd=upd,dupl=dupl)
IF (debug) WRITE (*, *) me,' ASB: From DCSDP',info,' ',A%FIDA IF (debug) WRITE (*, *) me,' ASB: From SPCNV',info,' ',A%FIDA
if (info /= psb_no_err_) then if (info /= psb_no_err_) then
info=4010 info=4010
ch_err='psb_spcnv' ch_err='psb_spcnv'

2
base/tools/psb_dspfree.f90
Unescape Escape View File

@ -36,7 +36,7 @@
! Parameters: ! Parameters:
! a - type(<psb_dspmat_type>). The sparse matrix to be freed. ! a - type(<psb_dspmat_type>). The sparse matrix to be freed.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code. ! info - integer. return code.
! !
subroutine psb_dspfree(a, desc_a,info) subroutine psb_dspfree(a, desc_a,info)
!...free sparse matrix structure... !...free sparse matrix structure...

31
base/tools/psb_dsphalo.F90
Unescape Escape View File

@ -37,21 +37,22 @@
! !
! !
! Parameters: ! Parameters:
! a - type(psb_dspmat_type) The local part of input matrix A ! a - type(psb_dspmat_type) The local part of input matrix A
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! blck - type(psb_dspmat_type) The local part of output matrix BLCK ! blck - type(psb_dspmat_type) The local part of output matrix BLCK
! info - integer. Return code ! info - integer. Return code
! rowcnv - logical Should row/col indices be converted ! rowcnv - logical Should row/col indices be converted
! colcnv - logical to/from global numbering when sent/received? ! colcnv - logical to/from global numbering when sent/received?
! default is .TRUE. ! default is .TRUE.
! rowscale - logical Should row/col indices on output be remapped ! rowscale - logical Should row/col indices on output be remapped
! colscale - logical from MIN:MAX to 1:(MAX-MIN+1) ? ! colscale - logical from MIN:MAX to 1:(MAX-MIN+1) ?
! default is .FALSE. ! default is .FALSE.
! (commmon use is ROWSCALE=.TRUE., COLSCALE=.FALSE.) ! (commmon use is ROWSCALE=.TRUE., COLSCALE=.FALSE.)
! data - integer Which index list in desc_a should be used to retrieve ! data - integer Which index list in desc_a should be used to retrieve
! rows, default psb_comm_halo_ (i.e.: use halo_index) ! rows, default psb_comm_halo_ (i.e.: use halo_index)
! other value psb_comm_ext_, no longer accepting ! other value psb_comm_ext_, no longer accepting
! psb_comm_ovrl_, perhaps should be reinstated in the future. ! psb_comm_ovrl_, perhaps should be reinstated in
! the future.
! !
! !
Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&

23
base/tools/psb_dspins.f90
Unescape Escape View File

@ -31,18 +31,21 @@
! File: psb_dspins.f90 ! File: psb_dspins.f90
! !
! Subroutine: psb_dspins ! Subroutine: psb_dspins
! Takes a cloud of points and inserts them into a sparse matrix. ! Takes a cloud of coefficients and inserts them into a sparse matrix.
! Note: coefficients with a row index not belonging to the current process are
! ignored.
! If desc_a is in the build state this routine implies a call to psb_cdins.
! !
! Parameters: ! Parameters:
! nz - integer. The number of points to insert. ! nz - integer. The number of points to insert.
! ia - integer,dimension(:). The row indices of the points. ! ia(:) - integer The row indices of the coefficients.
! ja - integer,dimension(:). The column indices of the points. ! ja(:) - integer The column indices of the coefficients.
! val - real,dimension(:). The values of the points to be inserted. ! val(:) - real The values of the coefficients to be inserted.
! a - type(<psb_dspmat_type>). The sparse destination matrix. ! a - type(<psb_dspmat_type>). The sparse destination matrix.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Error code ! info - integer. Error code
! rebuild - logical Allows to reopen a matrix under ! rebuild - logical Allows to reopen a matrix under
! certain circumstances. ! certain circumstances.
! !
subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild)

12
base/tools/psb_dsprn.f90
Unescape Escape View File

@ -31,13 +31,15 @@
! File: psb_dsprn.f90 ! File: psb_dsprn.f90
! !
! Subroutine: psb_dsprn ! Subroutine: psb_dsprn
! Reinit sparse matrix structure for psblas routines. ! Reinit sparse matrix structure for psblas routines: on output the matrix
! is in the update state.
! !
! Parameters: ! Parameters:
! a - type(<psb_dspmat_type>). The sparse matrix to be reinitiated. ! a - type(<psb_dspmat_type>). The sparse matrix to be reinitiated.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code. ! info - integer. Return code.
! ! clear - logical, optional Whether the coefficients should be zeroed
! default .true.
Subroutine psb_dsprn(a, desc_a,info,clear) Subroutine psb_dsprn(a, desc_a,info,clear)
use psb_descriptor_type use psb_descriptor_type

43
base/tools/psb_get_overlap.f90
Unescape Escape View File

@ -1,3 +1,46 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: psb_get_overlap.f90
!
! Subroutine: psb_get_overlap
! Extracts a list of overlap indices. If no overlap is present in
! the distribution the output vector is put in the unallocated state,
! otherwise its size is equal to the number of overlap indices on the
! current (calling) process.
!
! Parameters:
! ovrel(:) - integer, allocatable Array containing the output list
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. return code.
!
subroutine psb_get_ovrlap(ovrel,desc,info) subroutine psb_get_ovrlap(ovrel,desc,info)
use psb_descriptor_type use psb_descriptor_type
use psb_realloc_mod use psb_realloc_mod

93
base/tools/psb_glob_to_loc.f90
Unescape Escape View File

@ -31,14 +31,19 @@
! File: psb_glob_to_loc.f90 ! File: psb_glob_to_loc.f90
! !
! Subroutine: psb_glob_to_loc2 ! Subroutine: psb_glob_to_loc2
! Performs global to local indexes translation ! Performs global to local index translation. If an index does not belong
! to the current process, a negative value is returned (see also iact).
! !
! Parameters: ! Parameters:
! x - integer, dimension(:). Array containing the indices to be translated. ! x(:) - integer Array containing the indices to be translated.
! y - integer, dimension(:). Array containing the translated indices. ! y(:) - integer Array containing the translated indices.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code. ! info - integer. return code.
! iact - integer(optional). A character defining the behaviour of this subroutine when is found an index not belonging to the calling process ! iact - character, optional A character defining the behaviour on
! an index not belonging to the calling process
! 'I'gnore, 'W'arning, 'A'bort
! owned - logical, optional When .true. limits the input to indices strictly
! owned by the process, i.e. excludes halo.
! !
subroutine psb_glob_to_loc2(x,y,desc_a,info,iact,owned) subroutine psb_glob_to_loc2(x,y,desc_a,info,iact,owned)
@ -152,13 +157,19 @@ end subroutine psb_glob_to_loc2
!!$ !!$
!!$ !!$
! Subroutine: psb_glob_to_loc ! Subroutine: psb_glob_to_loc
! Performs global to local indexes translation ! Performs global to local index translation. If an index does not belong
! to the current process, a negative value is returned (see also iact).
! !
! Parameters: ! Parameters:
! x - integer, dimension(:). Array containing the indices to be translated. ! x(:) - integer Array containing the indices to be translated.
! overwritten on output with the result.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code. ! info - integer. return code.
! iact - integer(optional). A character defining the behaviour of this subroutine when is found an index not belonging to the calling process ! iact - character, optional A character defining the behaviour on
! an index not belonging to the calling process
! 'I'gnore, 'W'arning, 'A'bort
! owned - logical, optional When .true. limits the input to indices strictly
! owned by the process, i.e. excludes halo.
! !
subroutine psb_glob_to_loc(x,desc_a,info,iact,owned) subroutine psb_glob_to_loc(x,desc_a,info,iact,owned)
@ -240,69 +251,5 @@ subroutine psb_glob_to_loc(x,desc_a,info,iact,owned)
end if end if
return return
contains
subroutine inlbsrch(ipos,key,n,v)
implicit none
integer ipos, key, n
integer v(n)
integer lb, ub, m
lb = 1
ub = n
ipos = -1
do
if (lb > ub) return
m = (lb+ub)/2
if (key.eq.v(m)) then
ipos = m
return
else if (key.lt.v(m)) then
ub = m-1
else
lb = m + 1
end if
enddo
return
end subroutine inlbsrch
subroutine inner_cnv(n,x,hashsize,hashmask,hashv,glb_lc)
integer :: n, hashsize,hashmask,x(:), hashv(0:),glb_lc(:,:)
integer :: i, ih, key, idx,nh,tmp,lb,ub,lm
do i=1, n
key = x(i)
ih = iand(key,hashmask)
idx = hashv(ih)
nh = hashv(ih+1) - hashv(ih)
if (nh > 0) then
tmp = -1
lb = idx
ub = idx+nh-1
do
if (lb>ub) exit
lm = (lb+ub)/2
if (key==glb_lc(lm,1)) then
tmp = lm
exit
else if (key<glb_lc(lm,1)) then
ub = lm - 1
else
lb = lm + 1
end if
end do
else
tmp = -1
end if
if (tmp > 0) then
x(i) = glb_lc(tmp,2)
else
x(i) = tmp
end if
end do
end subroutine inner_cnv
end subroutine psb_glob_to_loc end subroutine psb_glob_to_loc

2
base/tools/psb_ialloc.f90
Unescape Escape View File

@ -32,6 +32,7 @@
! !
! Function: psb_ialloc ! Function: psb_ialloc
! Allocates dense integer matrix for PSBLAS routines ! Allocates dense integer matrix for PSBLAS routines
! The descriptor may be in either the build or assembled state.
! !
! Parameters: ! Parameters:
! x - the matrix to be allocated. ! x - the matrix to be allocated.
@ -178,6 +179,7 @@ end subroutine psb_ialloc
!!$ !!$
! Function: psb_iallocv ! Function: psb_iallocv
! Allocates dense matrix for PSBLAS routines ! Allocates dense matrix for PSBLAS routines
! The descriptor may be in either the build or assembled state.
! !
! Parameters: ! Parameters:
! m - integer. The number of rows. ! m - integer. The number of rows.

16
base/tools/psb_iasb.f90
Unescape Escape View File

@ -32,11 +32,15 @@
! !
! Subroutine: psb_iasb ! Subroutine: psb_iasb
! Assembles a dense matrix for PSBLAS routines ! Assembles a dense matrix for PSBLAS routines
! Since the allocation may have been called with the desciptor
! in the build state we make sure that X has a number of rows
! allowing for the halo indices, reallocating if necessary.
! We also call the halo routine for good measure.
! !
! Parameters: ! Parameters:
! x - integer,pointer,dimension(:,:). The matrix to be assembled. ! x(:,:) - integer,allocatable The matrix to be assembled.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. return code
subroutine psb_iasb(x, desc_a, info) subroutine psb_iasb(x, desc_a, info)
!....assembly dense matrix x ..... !....assembly dense matrix x .....
use psb_descriptor_type use psb_descriptor_type
@ -155,11 +159,15 @@ end subroutine psb_iasb
!!$ !!$
! Subroutine: psb_iasbv ! Subroutine: psb_iasbv
! Assembles a dense matrix for PSBLAS routines ! Assembles a dense matrix for PSBLAS routines
! Since the allocation may have been called with the desciptor
! in the build state we make sure that X has a number of rows
! allowing for the halo indices, reallocating if necessary.
! We also call the halo routine for good measure.
! !
! Parameters: ! Parameters:
! x - integer,pointer,dimension(:). The matrix to be assembled. ! x(:) - integer,allocatable The matrix to be assembled.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. return code
subroutine psb_iasbv(x, desc_a, info) subroutine psb_iasbv(x, desc_a, info)
!....assembly dense matrix x ..... !....assembly dense matrix x .....
use psb_descriptor_type use psb_descriptor_type

17
base/tools/psb_icdasb.F90
Unescape Escape View File

@ -31,15 +31,16 @@
! File: psb_cdasb.f90 ! File: psb_cdasb.f90
! !
! Subroutine: psb_cdasb ! Subroutine: psb_cdasb
! Assembly the psblas communications descriptor. ! Assemble the psblas communications descriptor.
! !
! Parameters: ! Parameters:
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code. ! info - integer. return code.
! ext_hv - logical Essentially this distinguishes a call ! ext_hv - logical Essentially this distinguishes a call
! coming from the build of an extended ! coming from the build of an extended
! halo descriptor with respect to a "normal" ! halo descriptor with respect to a "normal"
! call. ! call.
!
subroutine psb_icdasb(desc_a,info,ext_hv) subroutine psb_icdasb(desc_a,info,ext_hv)
use psb_descriptor_type use psb_descriptor_type
use psb_serial_mod use psb_serial_mod
@ -117,17 +118,21 @@ subroutine psb_icdasb(desc_a,info,ext_hv)
call psb_errpush(info,name,i_err=int_err) call psb_errpush(info,name,i_err=int_err)
goto 9999 goto 9999
endif endif
! Trim size of loc_to_glob component.
call psb_realloc(psb_cd_get_local_cols(desc_a),desc_a%loc_to_glob,info) call psb_realloc(psb_cd_get_local_cols(desc_a),desc_a%loc_to_glob,info)
! If large index space, we have to pre-process and rebuild
! the list of halo indices as if it was in small index space
if (psb_is_large_desc(desc_a)) then if (psb_is_large_desc(desc_a)) then
call psi_ldsc_pre_halo(desc_a,ext_hv_,info) call psi_ldsc_pre_halo(desc_a,ext_hv_,info)
end if end if
! Take out the lists for ovrlap, halo and ext...
call psb_transfer(desc_a%ovrlap_index,ovrlap_index,info) call psb_transfer(desc_a%ovrlap_index,ovrlap_index,info)
call psb_transfer(desc_a%halo_index,halo_index,info) call psb_transfer(desc_a%halo_index,halo_index,info)
call psb_transfer(desc_a%ext_index,ext_index,info) call psb_transfer(desc_a%ext_index,ext_index,info)
! Then convert and put them back where they belong.
call psi_cnv_dsc(halo_index,ovrlap_index,ext_index,desc_a,info) call psi_cnv_dsc(halo_index,ovrlap_index,ext_index,desc_a,info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='psi_cnv_dsc') call psb_errpush(4010,name,a_err='psi_cnv_dsc')
@ -141,8 +146,8 @@ subroutine psb_icdasb(desc_a,info,ext_hv)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
! Finally, cleanup the AVL tree, as it is really only needed ! Finally, cleanup the AVL tree of indices, if any, as it is
! when building. ! only needed while in the build state.
if (allocated(desc_a%ptree)) then if (allocated(desc_a%ptree)) then
call FreePairSearchTree(desc_a%ptree) call FreePairSearchTree(desc_a%ptree)
deallocate(desc_a%ptree,stat=info) deallocate(desc_a%ptree,stat=info)
@ -152,7 +157,7 @@ subroutine psb_icdasb(desc_a,info,ext_hv)
goto 9999 goto 9999
end if end if
end if end if
! Ok, register into MATRIX_DATA & free temporary work areas ! Ok, register into MATRIX_DATA
desc_a%matrix_data(psb_dec_type_) = psb_desc_asb_ desc_a%matrix_data(psb_dec_type_) = psb_desc_asb_
else else
info = 600 info = 600

4
base/tools/psb_ifree.f90
Unescape Escape View File

@ -34,7 +34,7 @@
! frees a dense integer matrix structure ! frees a dense integer matrix structure
! !
! Parameters: ! Parameters:
! x - integer, pointer, dimension(:,:). The dense matrix to be freed. ! x(:,:) - integer, allocatable The dense matrix to be freed.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. Eventually returns an error code
subroutine psb_ifree(x, desc_a, info) subroutine psb_ifree(x, desc_a, info)
@ -139,7 +139,7 @@ end subroutine psb_ifree
! frees a dense integer matrix structure ! frees a dense integer matrix structure
! !
! Parameters: ! Parameters:
! x - integer, pointer, dimension(:). The dense matrix to be freed. ! x(:) - integer, allocatable The dense matrix to be freed.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. Eventually returns an error code
subroutine psb_ifreev(x, desc_a,info) subroutine psb_ifreev(x, desc_a,info)

43
base/tools/psb_iins.f90
Unescape Escape View File

@ -29,16 +29,21 @@
!!$ !!$
!!$ !!$
! Subroutine: psb_iinsvi ! Subroutine: psb_iinsvi
! Insert dense submatrix to dense matrix. ! Insert dense submatrix to dense matrix. Note: the row indices in IRW
! are assumed to be in global numbering and are converted on the fly.
! Row indices not belonging to the current process are silently discarded.
! !
! Parameters: ! Parameters:
! m - integer. Number of rows of submatrix belonging to ! m - integer. Number of rows of submatrix belonging to
! val to be inserted. ! val to be inserted.
! irw - integer(:) Row indices of rows of val (global numbering) ! irw(:) - integer Row indices of rows of val (global numbering)
! val - integer, dimension(:). The source dense submatrix. ! val(:) - integer The source dense submatrix.
! x - integer, dimension(:). The destination dense matrix. ! x(:) - integer The destination dense matrix.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. return code
! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl) subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix ..... !....insert dense submatrix to dense matrix .....
use psb_descriptor_type use psb_descriptor_type
@ -74,11 +79,6 @@ subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_insvi' name = 'psb_insvi'
!!$ if (.not.allocated(desc_a%glob_to_loc)) then
!!$ info=3110
!!$ call psb_errpush(info,name)
!!$ return
!!$ end if
if ((.not.allocated(desc_a%matrix_data))) then if ((.not.allocated(desc_a%matrix_data))) then
int_err(1)=3110 int_err(1)=3110
call psb_errpush(info,name) call psb_errpush(info,name)
@ -213,16 +213,22 @@ end subroutine psb_iinsvi
!!$ !!$
!!$ !!$
! Subroutine: psb_iinsi ! Subroutine: psb_iinsi
! Insert dense submatrix to dense matrix. Note: the row indices in IRW
! are assumed to be in global numbering and are converted on the fly.
! Row indices not belonging to the current process are silently discarded.
! !
! Parameters: ! Parameters:
! m - integer. Number of rows of submatrix belonging to ! m - integer. Number of rows of submatrix belonging to
! val to be inserted. ! val to be inserted.
! irw - integer(:) Row indices of rows of val (global numbering) ! irw(:) - integer Row indices of rows of val (global numbering)
! val - integer, dimension(:,:). The source dense submatrix. ! val(:,:) - integer The source dense submatrix.
! x - integer, dimension(:,:). The destination dense matrix. ! x(:,:) - integer The destination dense matrix.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. return code
subroutine psb_iinsi(m,irw, val, x, desc_a, info, dupl) ! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_iinsi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix ..... !....insert dense submatrix to dense matrix .....
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type use psb_spmat_type
@ -258,11 +264,6 @@ subroutine psb_iinsi(m,irw, val, x, desc_a, info, dupl)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_iinsi' name = 'psb_iinsi'
!!$ if (.not.allocated(desc_a%glob_to_loc)) then
!!$ info=3110
!!$ call psb_errpush(info,name)
!!$ return
!!$ end if
if ((.not.allocated(desc_a%matrix_data))) then if ((.not.allocated(desc_a%matrix_data))) then
int_err(1)=3110 int_err(1)=3110
call psb_errpush(info,name) call psb_errpush(info,name)

36
base/tools/psb_loc_to_glob.f90
Unescape Escape View File

@ -31,14 +31,17 @@
! File: psb_loc_to_glob.f90 ! File: psb_loc_to_glob.f90
! !
! Subroutine: psb_loc_to_glob2 ! Subroutine: psb_loc_to_glob2
! Performs local to global indexes translation ! Performs local to global index translation. If an index is out of range
! a negative value is returned (see also iact).
! !
! Parameters: ! Parameters:
! x - integer, dimension(:). Array containing the indices to be translated. ! x(:) - integer Array containing the indices to be translated.
! y - integer, dimension(:). Array containing the indices to be translated. ! y(:) - integer Array containing the translated indices.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code. ! info - integer. return code.
! iact - integer(optional). A character defining the behaviour of this subroutine when is found an index not belonging to the calling process ! iact - character, optional A character defining the behaviour on
! an out of range index
! 'I'gnore, 'W'arning, 'A'bort
! !
subroutine psb_loc_to_glob2(x,y,desc_a,info,iact) subroutine psb_loc_to_glob2(x,y,desc_a,info,iact)
@ -100,9 +103,8 @@ subroutine psb_loc_to_glob2(x,y,desc_a,info,iact)
if (info /= 0) then if (info /= 0) then
select case(act) select case(act)
case('E') case('E','I')
call psb_erractionrestore(err_act) ! do nothing
return
case('W') case('W')
write(0,'("Error ",i5," in subroutine glob_to_loc")') info write(0,'("Error ",i5," in subroutine glob_to_loc")') info
case('A') case('A')
@ -158,13 +160,17 @@ end subroutine psb_loc_to_glob2
!!$ !!$
!!$ !!$
! Subroutine: psb_loc_to_glob ! Subroutine: psb_loc_to_glob
! Performs local to global indexes translation ! Performs local to global index translation. If an index is out of range
! a negative value is returned (see also iact).
! !
! Parameters: ! Parameters:
! x - integer, dimension(:). Array containing the indices to be translated. ! x(:) - integer Array containing the indices to be translated.
! Overwritten on output.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code. ! info - integer. return code.
! iact - integer(optional). A character defining the behaviour of this subroutine when is found an index not belonging to the calling process ! iact - character, optional A character defining the behaviour on
! an out of range index
! 'I'gnore, 'W'arning, 'A'bort
! !
subroutine psb_loc_to_glob(x,desc_a,info,iact) subroutine psb_loc_to_glob(x,desc_a,info,iact)
@ -223,9 +229,9 @@ subroutine psb_loc_to_glob(x,desc_a,info,iact)
if (info /= 0) then if (info /= 0) then
select case(act) select case(act)
case('E') case('E','I')
call psb_erractionrestore(err_act) !!$ call psb_erractionrestore(err_act)
return !!$ return
case('W') case('W')
write(0,'("Error ",i5," in subroutine glob_to_loc")') info write(0,'("Error ",i5," in subroutine glob_to_loc")') info
case('A') case('A')

2
base/tools/psb_zallc.f90
Unescape Escape View File

@ -33,6 +33,7 @@
! !
! Function: psb_zalloc ! Function: psb_zalloc
! Allocates dense matrix for PSBLAS routines ! Allocates dense matrix for PSBLAS routines
! The descriptor may be in either the build or assembled state.
! !
! Parameters: ! Parameters:
! x - the matrix to be allocated. ! x - the matrix to be allocated.
@ -179,6 +180,7 @@ end subroutine psb_zalloc
! !
! Function: psb_zallocv ! Function: psb_zallocv
! Allocates dense matrix for PSBLAS routines ! Allocates dense matrix for PSBLAS routines
! The descriptor may be in either the build or assembled state.
! !
! Parameters: ! Parameters:
! x - the matrix to be allocated. ! x - the matrix to be allocated.

16
base/tools/psb_zasb.f90
Unescape Escape View File

@ -32,11 +32,15 @@
! !
! Subroutine: psb_zasb ! Subroutine: psb_zasb
! Assembles a dense matrix for PSBLAS routines ! Assembles a dense matrix for PSBLAS routines
! Since the allocation may have been called with the desciptor
! in the build state we make sure that X has a number of rows
! allowing for the halo indices, reallocating if necessary.
! We also call the halo routine for good measure.
! !
! Parameters: ! Parameters:
! x - real,pointer(dim=2). The matrix to be assembled. ! x(:,:) - complex, allocatable The matrix to be assembled.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. return code
subroutine psb_zasb(x, desc_a, info) subroutine psb_zasb(x, desc_a, info)
!....assembly dense matrix x ..... !....assembly dense matrix x .....
use psb_descriptor_type use psb_descriptor_type
@ -158,11 +162,15 @@ end subroutine psb_zasb
!!$ !!$
! Subroutine: psb_zasb ! Subroutine: psb_zasb
! Assembles a dense matrix for PSBLAS routines ! Assembles a dense matrix for PSBLAS routines
! Since the allocation may have been called with the desciptor
! in the build state we make sure that X has a number of rows
! allowing for the halo indices, reallocating if necessary.
! We also call the halo routine for good measure.
! !
! Parameters: ! Parameters:
! x - real,pointer(dim=1). The matrix to be assembled. ! x(:) - complex, allocatable The matrix to be assembled.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. Return code
subroutine psb_zasbv(x, desc_a, info) subroutine psb_zasbv(x, desc_a, info)
!....assembly dense matrix x ..... !....assembly dense matrix x .....
use psb_descriptor_type use psb_descriptor_type

12
base/tools/psb_zfree.f90
Unescape Escape View File

@ -34,9 +34,9 @@
! frees a dense matrix structure ! frees a dense matrix structure
! !
! Parameters: ! Parameters:
! x - real, allocatable, dimension(:,:). The dense matrix to be freed. ! x(:,:) - complex, allocatable The dense matrix to be freed.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
subroutine psb_zfree(x, desc_a, info) subroutine psb_zfree(x, desc_a, info)
!...free dense matrix structure... !...free dense matrix structure...
use psb_const_mod use psb_const_mod
@ -109,9 +109,9 @@ end subroutine psb_zfree
! frees a dense matrix structure ! frees a dense matrix structure
! !
! Parameters: ! Parameters:
! x - real, allocatable, dimension(:). The dense matrix to be freed. ! x(:) - complex, allocatable The dense matrix to be freed.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Return code ! info - integer. Return code
subroutine psb_zfreev(x, desc_a, info) subroutine psb_zfreev(x, desc_a, info)
!...free dense matrix structure... !...free dense matrix structure...
use psb_const_mod use psb_const_mod

43
base/tools/psb_zins.f90
Unescape Escape View File

@ -29,16 +29,21 @@
!!$ !!$
!!$ !!$
! Subroutine: psb_zinsvi ! Subroutine: psb_zinsvi
! Insert dense submatrix to dense matrix. ! Insert dense submatrix to dense matrix. Note: the row indices in IRW
! are assumed to be in global numbering and are converted on the fly.
! Row indices not belonging to the current process are silently discarded.
! !
! Parameters: ! Parameters:
! m - integer. Number of rows of submatrix belonging to ! m - integer. Number of rows of submatrix belonging to
! val to be inserted. ! val to be inserted.
! irw - integer(:) Row indices of rows of val (global numbering) ! irw(:) - integer Row indices of rows of val (global numbering)
! val - complex, dimension(:). The source dense submatrix. ! val(:) - complex The source dense submatrix.
! x - complex, dimension(:). The destination dense matrix. ! x(:) - complex The destination dense matrix.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. return code
! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl) subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix ..... !....insert dense submatrix to dense matrix .....
use psb_descriptor_type use psb_descriptor_type
@ -75,11 +80,6 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_zinsvi' name = 'psb_zinsvi'
!!$ if (.not.allocated(desc_a%glob_to_loc)) then
!!$ info=3110
!!$ call psb_errpush(info,name)
!!$ return
!!$ end if
if ((.not.allocated(desc_a%matrix_data))) then if ((.not.allocated(desc_a%matrix_data))) then
int_err(1)=3110 int_err(1)=3110
call psb_errpush(info,name) call psb_errpush(info,name)
@ -214,16 +214,22 @@ end subroutine psb_zinsvi
!!$ !!$
!!$ !!$
! Subroutine: psb_zinsi ! Subroutine: psb_zinsi
! Insert dense submatrix to dense matrix. Note: the row indices in IRW
! are assumed to be in global numbering and are converted on the fly.
! Row indices not belonging to the current process are silently discarded.
! !
! Parameters: ! Parameters:
! m - integer. Number of rows of submatrix belonging to ! m - integer. Number of rows of submatrix belonging to
! val to be inserted. ! val to be inserted.
! irw - integer(:) Row indices of rows of val (global numbering) ! irw(:) - integer Row indices of rows of val (global numbering)
! val - complex, dimension(:,:). The source dense submatrix. ! val(:,:) - complex The source dense submatrix.
! x - complex, dimension(:,:). The destination dense matrix. ! x(:,:) - complex The destination dense matrix.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code ! info - integer. return code
subroutine psb_zinsi(m,irw, val, x, desc_a, info, dupl) ! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl)
!....insert dense submatrix to dense matrix ..... !....insert dense submatrix to dense matrix .....
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type use psb_spmat_type
@ -259,11 +265,6 @@ subroutine psb_zinsi(m,irw, val, x, desc_a, info, dupl)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_zinsi' name = 'psb_zinsi'
!!$ if (.not.allocated(desc_a%glob_to_loc)) then
!!$ info=3110
!!$ call psb_errpush(info,name)
!!$ return
!!$ end if
if ((.not.allocated(desc_a%matrix_data))) then if ((.not.allocated(desc_a%matrix_data))) then
int_err(1)=3110 int_err(1)=3110
call psb_errpush(info,name) call psb_errpush(info,name)

23
base/tools/psb_zspalloc.f90
Unescape Escape View File

@ -36,8 +36,9 @@
! Parameters: ! Parameters:
! a - type(<psb_zspmat_type>). The sparse matrix to be allocated. ! a - type(<psb_zspmat_type>). The sparse matrix to be allocated.
! desc_a - type(<psb_desc_type>). The communication descriptor to be updated. ! desc_a - type(<psb_desc_type>). The communication descriptor to be updated.
! info - integer. Possibly returns an error code. ! info - integer. Return code.
! nnz - integer(optional). The number of nonzeroes in the matrix. ! nnz - integer(optional). The number of nonzeroes in the matrix.
! (local, user estimate)
! !
subroutine psb_zspalloc(a, desc_a, info, nnz) subroutine psb_zspalloc(a, desc_a, info, nnz)
@ -56,8 +57,8 @@ subroutine psb_zspalloc(a, desc_a, info, nnz)
integer, optional, intent(in) :: nnz integer, optional, intent(in) :: nnz
!locals !locals
integer :: ictxt integer :: ictxt, dectype
integer :: np,me,loc_row,& integer :: np,me,loc_row,loc_col,&
& length_ia1,length_ia2, err_act,m,n & length_ia1,length_ia2, err_act,m,n
integer :: int_err(5) integer :: int_err(5)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -68,7 +69,9 @@ subroutine psb_zspalloc(a, desc_a, info, nnz)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_zspalloc' name = 'psb_zspalloc'
ictxt = psb_cd_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
dectype = psb_cd_get_dectype(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
! ....verify blacs grid correctness.. ! ....verify blacs grid correctness..
if (np == -1) then if (np == -1) then
@ -77,14 +80,9 @@ subroutine psb_zspalloc(a, desc_a, info, nnz)
goto 9999 goto 9999
endif endif
!
! hmm, not a good idea, not all compilers can rely on any given
! value for non initialized pointers. let's avoid this,
! and just rely on documentation.
! check if psdalloc is already called for this matrix
! set fields in desc_a%matrix_data....
loc_row = psb_cd_get_local_rows(desc_a) loc_row = psb_cd_get_local_rows(desc_a)
loc_col = psb_cd_get_local_cols(desc_a)
m = psb_cd_get_global_rows(desc_a) m = psb_cd_get_global_rows(desc_a)
n = psb_cd_get_global_cols(desc_a) n = psb_cd_get_global_cols(desc_a)
@ -100,14 +98,13 @@ subroutine psb_zspalloc(a, desc_a, info, nnz)
length_ia1=nnz length_ia1=nnz
length_ia2=nnz length_ia2=nnz
else else
length_ia1=max(1,4*loc_row) length_ia1=max(1,5*loc_row)
length_ia2=max(1,4*loc_row)
endif endif
if (debug) write(*,*) 'allocating size:',length_ia1 if (debug) write(*,*) 'allocating size:',length_ia1
!....allocate aspk, ia1, ia2..... !....allocate aspk, ia1, ia2.....
call psb_sp_all(loc_row,loc_row,a,length_ia1,info) call psb_sp_all(loc_row,loc_col,a,length_ia1,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='sp_all' ch_err='sp_all'

23
base/tools/psb_zspasb.f90
Unescape Escape View File

@ -31,16 +31,21 @@
! File: psb_zspasb.f90 ! File: psb_zspasb.f90
! !
! Subroutine: psb_zspasb ! Subroutine: psb_zspasb
! Assembly sparse matrix and set psblas communications ! Assemble sparse matrix
! structures.
! !
! Parameters: ! Parameters:
! a - type(<psb_zspmat_type>). The sparse matrix to be allocated. ! a - type(<psb_zspmat_type>). The sparse matrix to be assembled
! desc_a - type(<psb_desc_type>). The communication descriptor to be updated. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code. ! info - integer. return code.
! afmt - character,dimension(5)(optional). The output format. ! afmt - character(optional) The desired output storage format.
! up - character(optional). ??? ! upd - character(optional). How will the matrix be updated?
! dup - integer(optional). ??? ! psb_upd_srch_ Simple strategy
! psb_upd_perm_ Permutation(more memory)
! dupl - integer(optional). Duplicate coefficient handling:
! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add
! psb_dupl_err_ raise an error.
!
! !
subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl) subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl)
@ -113,7 +118,7 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl)
call psb_spcnv(a,info,afmt=afmt,upd=upd,dupl=dupl) call psb_spcnv(a,info,afmt=afmt,upd=upd,dupl=dupl)
IF (debug) WRITE (*, *) me,' ASB: From DCSDP',info,' ',A%FIDA IF (debug) WRITE (*, *) me,' ASB: From spcnv',info,' ',A%FIDA
if (info /= psb_no_err_) then if (info /= psb_no_err_) then
info=4010 info=4010
ch_err='psb_spcnv' ch_err='psb_spcnv'

2
base/tools/psb_zspfree.f90
Unescape Escape View File

@ -36,7 +36,7 @@
! Parameters: ! Parameters:
! a - type(<psb_zspmat_type>). The sparse matrix to be freed. ! a - type(<psb_zspmat_type>). The sparse matrix to be freed.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code. ! info - integer. return code.
! !
subroutine psb_zspfree(a, desc_a,info) subroutine psb_zspfree(a, desc_a,info)
!...free sparse matrix structure... !...free sparse matrix structure...

31
base/tools/psb_zsphalo.F90
Unescape Escape View File

@ -37,21 +37,22 @@
! !
! !
! Parameters: ! Parameters:
! a - type(psb_zspmat_type) The local part of input matrix A ! a - type(psb_zspmat_type) The local part of input matrix A
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! blck - type(psb_zspmat_type) The local part of output matrix BLCK ! blck - type(psb_zspmat_type) The local part of output matrix BLCK
! info - integer. Return code ! info - integer. Return code
! rowcnv - logical Should row/col indices be converted ! rowcnv - logical Should row/col indices be converted
! colcnv - logical to/from global numbering when sent/received? ! colcnv - logical to/from global numbering when sent/received?
! default is .TRUE. ! default is .TRUE.
! rowscale - logical Should row/col indices on output be remapped ! rowscale - logical Should row/col indices on output be remapped
! colscale - logical from MIN:MAX to 1:(MAX-MIN+1) ? ! colscale - logical from MIN:MAX to 1:(MAX-MIN+1) ?
! default is .FALSE. ! default is .FALSE.
! (commmon use is ROWSCALE=.TRUE., COLSCALE=.FALSE.) ! (commmon use is ROWSCALE=.TRUE., COLSCALE=.FALSE.)
! data - integer Which index list in desc_a should be used to retrieve ! data - integer Which index list in desc_a should be used to retrieve
! rows, default psb_comm_halo_ (i.e.: use halo_index) ! rows, default psb_comm_halo_ (i.e.: use halo_index)
! other value psb_comm_ext_, no longer accepting ! other value psb_comm_ext_, no longer accepting
! psb_comm_ovrl_, perhaps should be reinstated in the future. ! psb_comm_ovrl_, perhaps should be reinstated in
! the future.
! !
! !
Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&

23
base/tools/psb_zspins.f90
Unescape Escape View File

@ -31,18 +31,21 @@
! File: psb_zspins.f90 ! File: psb_zspins.f90
! !
! Subroutine: psb_zspins ! Subroutine: psb_zspins
! Takes a cloud of points and inserts them into a sparse matrix. ! Takes a cloud of coefficients and inserts them into a sparse matrix.
! Note: coefficients with a row index not belonging to the current process are
! ignored.
! If desc_a is in the build state this routine implies a call to psb_cdins.
! !
! Parameters: ! Parameters:
! nz - integer. The number of points to insert. ! nz - integer. The number of points to insert.
! ia - integer,dimension(:). The row indices of the points. ! ia(:) - integer The row indices of the coefficients.
! ja - integer,dimension(:). The column indices of the points. ! ja(:) - integer The column indices of the coefficients.
! val - real,dimension(:). The values of the points to be inserted. ! val(:) - complex The values of the coefficients to be inserted.
! a - type(<psb_zspmat_type>). The sparse destination matrix. ! a - type(<psb_dspmat_type>). The sparse destination matrix.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Error code ! info - integer. Error code
! rebuild - logical Allows to reopen a matrix under ! rebuild - logical Allows to reopen a matrix under
! certain circumstances. ! certain circumstances.
! !
subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild)

11
base/tools/psb_zsprn.f90
Unescape Escape View File

@ -31,12 +31,15 @@
! File: psb_zsprn.f90 ! File: psb_zsprn.f90
! !
! Subroutine: psb_zsprn ! Subroutine: psb_zsprn
! Reinit sparse matrix structure for psblas routines. ! Reinit sparse matrix structure for psblas routines: on output the matrix
! is in the update state.
! !
! Parameters: ! Parameters:
! a - type(<psb_zspmat_type>). The sparse matrix to be reinitiated. ! a - type(<psb_zspmat_type>). The sparse matrix to be reinitiated.
! desc_a - type(<psb_desc_type>). The communication descriptor. ! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code. ! info - integer. Return code.
! clear - logical, optional Whether the coefficients should be zeroed
! default .true.
! !
Subroutine psb_zsprn(a, desc_a,info,clear) Subroutine psb_zsprn(a, desc_a,info,clear)

Write Preview
Loading…
Cancel
Save