diff --git a/base/tools/psb_cdfree.f90 b/base/tools/psb_cdfree.f90 index 7ed4fb00..3d22dc91 100644 --- a/base/tools/psb_cdfree.f90 +++ b/base/tools/psb_cdfree.f90 @@ -35,7 +35,7 @@ ! ! Parameters: ! desc_a - type(). The communication descriptor to be freed. -! info - integer. Eventually returns an error code. +! info - integer. return code. subroutine psb_cdfree(desc_a,info) !...free descriptor structure... use psb_descriptor_type diff --git a/base/tools/psb_cdtransfer.f90 b/base/tools/psb_cdtransfer.f90 index c950b2aa..e8daf314 100644 --- a/base/tools/psb_cdtransfer.f90 +++ b/base/tools/psb_cdtransfer.f90 @@ -31,7 +31,9 @@ ! File: psb_cdtransfer.f90 ! ! 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: ! desc_in - type(). The communication descriptor to be diff --git a/base/tools/psb_dallc.f90 b/base/tools/psb_dallc.f90 index 07f5c761..48994028 100644 --- a/base/tools/psb_dallc.f90 +++ b/base/tools/psb_dallc.f90 @@ -32,12 +32,13 @@ ! File: psb_dallc.f90 ! ! 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: ! x - the matrix to be allocated. ! desc_a - the communication descriptor. -! info - possibly returns an error code +! info - Return code ! n - optional number of columns. subroutine psb_dalloc(x, desc_a, info, n) !....allocate dense matrix for psblas routines..... @@ -178,13 +179,15 @@ end subroutine psb_dalloc !!$ !!$ ! +! ! 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: ! x - the matrix to be allocated. ! desc_a - the communication descriptor. -! info - possibly returns an error code +! info - return code subroutine psb_dallocv(x, desc_a,info,n) !....allocate sparse matrix structure for psblas routines..... use psb_descriptor_type diff --git a/base/tools/psb_dasb.f90 b/base/tools/psb_dasb.f90 index d98e327d..bac68d72 100644 --- a/base/tools/psb_dasb.f90 +++ b/base/tools/psb_dasb.f90 @@ -31,12 +31,16 @@ ! File: psb_dasb.f90 ! ! 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: -! x - real,pointer(dim=2). The matrix to be assembled. +! x(:,:) - real,allocatable The matrix to be assembled. ! desc_a - type(). The communication descriptor. -! info - integer. Eventually returns an error code +! info - integer. return code subroutine psb_dasb(x, desc_a, info) !....assembly dense matrix x ..... use psb_descriptor_type @@ -161,11 +165,15 @@ end subroutine psb_dasb !!$ ! Subroutine: psb_dasb ! 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: -! x - real,pointer(dim=1). The matrix to be assembled. +! x(:) - real,allocatable The matrix to be assembled. ! desc_a - type(). The communication descriptor. -! info - integer. Eventually returns an error code +! info - integer. Return code subroutine psb_dasbv(x, desc_a, info) !....assembly dense matrix x ..... use psb_descriptor_type diff --git a/base/tools/psb_dfree.f90 b/base/tools/psb_dfree.f90 index f1cd3340..685cc6b6 100644 --- a/base/tools/psb_dfree.f90 +++ b/base/tools/psb_dfree.f90 @@ -34,9 +34,9 @@ ! frees a dense matrix structure ! ! Parameters: -! x - real, allocatable, dimension(:,:). The dense matrix to be freed. -! desc_a - type(). The communication descriptor. -! info - integer. Return code +! x(:,:) - real, allocatable The dense matrix to be freed. +! desc_a - type(). The communication descriptor. +! info - integer. Return code subroutine psb_dfree(x, desc_a, info) !...free dense matrix structure... use psb_const_mod @@ -109,9 +109,9 @@ end subroutine psb_dfree ! frees a dense matrix structure ! ! Parameters: -! x - real, allocatable, dimension(:). The dense matrix to be freed. -! desc_a - type(). The communication descriptor. -! info - integer. Return code +! x():) - real, allocatable The dense matrix to be freed. +! desc_a - type(). The communication descriptor. +! info - integer. Return code subroutine psb_dfreev(x, desc_a, info) !...free dense matrix structure... use psb_const_mod diff --git a/base/tools/psb_dins.f90 b/base/tools/psb_dins.f90 index b9068c82..8d5e6c58 100644 --- a/base/tools/psb_dins.f90 +++ b/base/tools/psb_dins.f90 @@ -29,16 +29,21 @@ !!$ !!$ ! 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: ! m - integer. Number of rows of submatrix belonging to ! val to be inserted. -! irw - integer(:) Row indices of rows of val (global numbering) -! val - real, dimension(:). The source dense submatrix. -! x - real, dimension(:). The destination dense matrix. +! irw(:) - integer Row indices of rows of val (global numbering) +! val(:) - real The source dense submatrix. +! x(:) - real The destination dense matrix. ! desc_a - 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) !....insert dense submatrix to dense matrix ..... use psb_const_mod @@ -74,11 +79,6 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl) call psb_erractionsave(err_act) 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 int_err(1)=3110 call psb_errpush(info,name) @@ -132,7 +132,7 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl) else dupl_ = psb_dupl_ovwrt_ endif - + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) select case(dupl_) @@ -214,15 +214,21 @@ end subroutine psb_dinsvi !!$ !!$ ! 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: -! m - integer. Number of rows of submatrix belonging to +! m - integer. Number of rows of submatrix belonging to ! val to be inserted. -! irw - integer(:) Row indices of rows of val (global numbering) -! val - real, dimension(:,:). The source dense submatrix. -! x - real, dimension(:,:). The destination dense matrix. -! desc_a - type(). The communication descriptor. -! info - integer. Eventually returns an error code +! irw(:) - integer Row indices of rows of val (global numbering) +! val(:,:) - real The source dense submatrix. +! x(:,:) - real The destination dense matrix. +! desc_a - type(). The communication descriptor. +! 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) !....insert dense submatrix to dense matrix ..... use psb_descriptor_type @@ -259,11 +265,6 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl) call psb_erractionsave(err_act) 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 int_err(1)=3110 call psb_errpush(info,name) diff --git a/base/tools/psb_dspalloc.f90 b/base/tools/psb_dspalloc.f90 index facc5eef..baa1eeea 100644 --- a/base/tools/psb_dspalloc.f90 +++ b/base/tools/psb_dspalloc.f90 @@ -36,8 +36,9 @@ ! Parameters: ! a - type(). The sparse matrix to be allocated. ! desc_a - 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. +! (local, user estimate) ! subroutine psb_dspalloc(a, desc_a, info, nnz) @@ -57,7 +58,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) !locals integer :: ictxt, dectype - integer :: np,me,loc_row,& + integer :: np,me,loc_row,loc_col,& & length_ia1,length_ia2, err_act,m,n integer :: int_err(5) logical, parameter :: debug=.false. @@ -79,14 +80,9 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) goto 9999 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_col = psb_cd_get_local_cols(desc_a) m = psb_cd_get_global_rows(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_ia2=nnz else - length_ia1=max(1,4*loc_row) - length_ia2=max(1,4*loc_row) + length_ia1=max(1,5*loc_row) endif if (debug) write(*,*) 'allocating size:',length_ia1 !....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 info=4010 ch_err='sp_all' diff --git a/base/tools/psb_dspasb.f90 b/base/tools/psb_dspasb.f90 index 3022898d..1182a3e3 100644 --- a/base/tools/psb_dspasb.f90 +++ b/base/tools/psb_dspasb.f90 @@ -31,19 +31,23 @@ ! File: psb_dspasb.f90 ! ! Subroutine: psb_dspasb -! Assembly sparse matrix and set psblas communications -! structures. -! +! Assemble sparse matrix +! ! Parameters: -! a - type(). The sparse matrix to be allocated. -! desc_a - type(). The communication descriptor to be updated. -! info - integer. Eventually returns an error code. -! afmt - character,dimension(5)(optional). The output format. -! up - character(optional). ??? -! dup - integer(optional). ??? +! a - type(). The sparse matrix to be allocated. +! desc_a - type(). The communication descriptor. +! info - integer. return code. +! afmt - character(optional) The desired output storage format. +! upd - character(optional). How will the matrix be updated? +! 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) - use psb_descriptor_type use psb_spmat_type 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) - 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 info=4010 ch_err='psb_spcnv' diff --git a/base/tools/psb_dspfree.f90 b/base/tools/psb_dspfree.f90 index 1a25bfbc..5182634c 100644 --- a/base/tools/psb_dspfree.f90 +++ b/base/tools/psb_dspfree.f90 @@ -36,7 +36,7 @@ ! Parameters: ! a - type(). The sparse matrix to be freed. ! desc_a - type(). The communication descriptor. -! info - integer. Eventually returns an error code. +! info - integer. return code. ! subroutine psb_dspfree(a, desc_a,info) !...free sparse matrix structure... diff --git a/base/tools/psb_dsphalo.F90 b/base/tools/psb_dsphalo.F90 index a66f5f83..3b4a9d4d 100644 --- a/base/tools/psb_dsphalo.F90 +++ b/base/tools/psb_dsphalo.F90 @@ -37,21 +37,22 @@ ! ! ! Parameters: -! a - type(psb_dspmat_type) The local part of input matrix A -! desc_a - type(). The communication descriptor. -! blck - type(psb_dspmat_type) The local part of output matrix BLCK -! info - integer. Return code -! rowcnv - logical Should row/col indices be converted -! colcnv - logical to/from global numbering when sent/received? -! default is .TRUE. -! rowscale - logical Should row/col indices on output be remapped -! colscale - logical from MIN:MAX to 1:(MAX-MIN+1) ? -! default is .FALSE. -! (commmon use is ROWSCALE=.TRUE., COLSCALE=.FALSE.) -! data - integer Which index list in desc_a should be used to retrieve -! rows, default psb_comm_halo_ (i.e.: use halo_index) -! other value psb_comm_ext_, no longer accepting -! psb_comm_ovrl_, perhaps should be reinstated in the future. +! a - type(psb_dspmat_type) The local part of input matrix A +! desc_a - type(). The communication descriptor. +! blck - type(psb_dspmat_type) The local part of output matrix BLCK +! info - integer. Return code +! rowcnv - logical Should row/col indices be converted +! colcnv - logical to/from global numbering when sent/received? +! default is .TRUE. +! rowscale - logical Should row/col indices on output be remapped +! colscale - logical from MIN:MAX to 1:(MAX-MIN+1) ? +! default is .FALSE. +! (commmon use is ROWSCALE=.TRUE., COLSCALE=.FALSE.) +! data - integer Which index list in desc_a should be used to retrieve +! rows, default psb_comm_halo_ (i.e.: use halo_index) +! other value psb_comm_ext_, no longer accepting +! psb_comm_ovrl_, perhaps should be reinstated in +! the future. ! ! Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& diff --git a/base/tools/psb_dspins.f90 b/base/tools/psb_dspins.f90 index 876366ca..ccf0c028 100644 --- a/base/tools/psb_dspins.f90 +++ b/base/tools/psb_dspins.f90 @@ -31,18 +31,21 @@ ! File: psb_dspins.f90 ! ! 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: -! nz - integer. The number of points to insert. -! ia - integer,dimension(:). The row indices of the points. -! ja - integer,dimension(:). The column indices of the points. -! val - real,dimension(:). The values of the points to be inserted. -! a - type(). The sparse destination matrix. -! desc_a - type(). The communication descriptor. -! info - integer. Error code -! rebuild - logical Allows to reopen a matrix under -! certain circumstances. +! nz - integer. The number of points to insert. +! ia(:) - integer The row indices of the coefficients. +! ja(:) - integer The column indices of the coefficients. +! val(:) - real The values of the coefficients to be inserted. +! a - type(). The sparse destination matrix. +! desc_a - type(). The communication descriptor. +! info - integer. Error code +! rebuild - logical Allows to reopen a matrix under +! certain circumstances. ! subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) diff --git a/base/tools/psb_dsprn.f90 b/base/tools/psb_dsprn.f90 index a6901689..6790ef8f 100644 --- a/base/tools/psb_dsprn.f90 +++ b/base/tools/psb_dsprn.f90 @@ -31,13 +31,15 @@ ! File: psb_dsprn.f90 ! ! 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: -! a - type(). The sparse matrix to be reinitiated. -! desc_a - type(). The communication descriptor. -! info - integer. Eventually returns an error code. -! +! a - type(). The sparse matrix to be reinitiated. +! desc_a - type(). The communication descriptor. +! info - integer. Return code. +! clear - logical, optional Whether the coefficients should be zeroed +! default .true. Subroutine psb_dsprn(a, desc_a,info,clear) use psb_descriptor_type diff --git a/base/tools/psb_get_overlap.f90 b/base/tools/psb_get_overlap.f90 index 82b2a3e0..56077f6b 100644 --- a/base/tools/psb_get_overlap.f90 +++ b/base/tools/psb_get_overlap.f90 @@ -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(). The communication descriptor. +! info - integer. return code. +! subroutine psb_get_ovrlap(ovrel,desc,info) use psb_descriptor_type use psb_realloc_mod diff --git a/base/tools/psb_glob_to_loc.f90 b/base/tools/psb_glob_to_loc.f90 index 52ef6aa1..0e6276cd 100644 --- a/base/tools/psb_glob_to_loc.f90 +++ b/base/tools/psb_glob_to_loc.f90 @@ -31,14 +31,19 @@ ! File: psb_glob_to_loc.f90 ! ! 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: -! x - integer, dimension(:). Array containing the indices to be translated. -! y - integer, dimension(:). Array containing the translated indices. +! x(:) - integer Array containing the indices to be translated. +! y(:) - integer Array containing the translated indices. ! desc_a - type(). The communication descriptor. -! info - integer. Eventually returns an error code. -! iact - integer(optional). A character defining the behaviour of this subroutine when is found an index not belonging to the calling process +! info - integer. return code. +! 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) @@ -152,13 +157,19 @@ end subroutine psb_glob_to_loc2 !!$ !!$ ! 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: -! 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(). The communication descriptor. -! info - integer. Eventually returns an error code. -! iact - integer(optional). A character defining the behaviour of this subroutine when is found an index not belonging to the calling process +! info - integer. return code. +! 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) @@ -240,69 +251,5 @@ subroutine psb_glob_to_loc(x,desc_a,info,iact,owned) end if 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 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 diff --git a/base/tools/psb_ialloc.f90 b/base/tools/psb_ialloc.f90 index 4fd98bdf..dd212e56 100644 --- a/base/tools/psb_ialloc.f90 +++ b/base/tools/psb_ialloc.f90 @@ -32,6 +32,7 @@ ! ! Function: psb_ialloc ! Allocates dense integer matrix for PSBLAS routines +! The descriptor may be in either the build or assembled state. ! ! Parameters: ! x - the matrix to be allocated. @@ -178,6 +179,7 @@ end subroutine psb_ialloc !!$ ! Function: psb_iallocv ! Allocates dense matrix for PSBLAS routines +! The descriptor may be in either the build or assembled state. ! ! Parameters: ! m - integer. The number of rows. diff --git a/base/tools/psb_iasb.f90 b/base/tools/psb_iasb.f90 index 057200d2..866be5cc 100644 --- a/base/tools/psb_iasb.f90 +++ b/base/tools/psb_iasb.f90 @@ -32,11 +32,15 @@ ! ! Subroutine: psb_iasb ! 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: -! x - integer,pointer,dimension(:,:). The matrix to be assembled. +! x(:,:) - integer,allocatable The matrix to be assembled. ! desc_a - type(). The communication descriptor. -! info - integer. Eventually returns an error code +! info - integer. return code subroutine psb_iasb(x, desc_a, info) !....assembly dense matrix x ..... use psb_descriptor_type @@ -155,11 +159,15 @@ end subroutine psb_iasb !!$ ! Subroutine: psb_iasbv ! 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: -! x - integer,pointer,dimension(:). The matrix to be assembled. +! x(:) - integer,allocatable The matrix to be assembled. ! desc_a - type(). The communication descriptor. -! info - integer. Eventually returns an error code +! info - integer. return code subroutine psb_iasbv(x, desc_a, info) !....assembly dense matrix x ..... use psb_descriptor_type diff --git a/base/tools/psb_icdasb.F90 b/base/tools/psb_icdasb.F90 index cac18491..1edca69a 100644 --- a/base/tools/psb_icdasb.F90 +++ b/base/tools/psb_icdasb.F90 @@ -31,15 +31,16 @@ ! File: psb_cdasb.f90 ! ! Subroutine: psb_cdasb -! Assembly the psblas communications descriptor. +! Assemble the psblas communications descriptor. ! ! Parameters: ! desc_a - type(). The communication descriptor. -! info - integer. Eventually returns an error code. +! info - integer. return code. ! ext_hv - logical Essentially this distinguishes a call ! coming from the build of an extended ! halo descriptor with respect to a "normal" ! call. +! subroutine psb_icdasb(desc_a,info,ext_hv) use psb_descriptor_type 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) goto 9999 endif - + ! Trim size of loc_to_glob component. 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 call psi_ldsc_pre_halo(desc_a,ext_hv_,info) 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%halo_index,halo_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) if (info /= 0) then 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) goto 9999 end if - ! Finally, cleanup the AVL tree, as it is really only needed - ! when building. + ! Finally, cleanup the AVL tree of indices, if any, as it is + ! only needed while in the build state. if (allocated(desc_a%ptree)) then call FreePairSearchTree(desc_a%ptree) deallocate(desc_a%ptree,stat=info) @@ -152,7 +157,7 @@ subroutine psb_icdasb(desc_a,info,ext_hv) goto 9999 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_ else info = 600 diff --git a/base/tools/psb_ifree.f90 b/base/tools/psb_ifree.f90 index 607f553b..01df90df 100644 --- a/base/tools/psb_ifree.f90 +++ b/base/tools/psb_ifree.f90 @@ -34,7 +34,7 @@ ! frees a dense integer matrix structure ! ! Parameters: -! x - integer, pointer, dimension(:,:). The dense matrix to be freed. +! x(:,:) - integer, allocatable The dense matrix to be freed. ! desc_a - type(). The communication descriptor. ! info - integer. Eventually returns an error code subroutine psb_ifree(x, desc_a, info) @@ -139,7 +139,7 @@ end subroutine psb_ifree ! frees a dense integer matrix structure ! ! Parameters: -! x - integer, pointer, dimension(:). The dense matrix to be freed. +! x(:) - integer, allocatable The dense matrix to be freed. ! desc_a - type(). The communication descriptor. ! info - integer. Eventually returns an error code subroutine psb_ifreev(x, desc_a,info) diff --git a/base/tools/psb_iins.f90 b/base/tools/psb_iins.f90 index d276c10a..c4245268 100644 --- a/base/tools/psb_iins.f90 +++ b/base/tools/psb_iins.f90 @@ -29,16 +29,21 @@ !!$ !!$ ! 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: ! m - integer. Number of rows of submatrix belonging to ! val to be inserted. -! irw - integer(:) Row indices of rows of val (global numbering) -! val - integer, dimension(:). The source dense submatrix. -! x - integer, dimension(:). The destination dense matrix. +! irw(:) - integer Row indices of rows of val (global numbering) +! val(:) - integer The source dense submatrix. +! x(:) - integer The destination dense matrix. ! desc_a - 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) !....insert dense submatrix to dense matrix ..... use psb_descriptor_type @@ -74,11 +79,6 @@ subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl) call psb_erractionsave(err_act) 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 int_err(1)=3110 call psb_errpush(info,name) @@ -213,16 +213,22 @@ end subroutine psb_iinsvi !!$ !!$ ! 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: ! m - integer. Number of rows of submatrix belonging to ! val to be inserted. -! irw - integer(:) Row indices of rows of val (global numbering) -! val - integer, dimension(:,:). The source dense submatrix. -! x - integer, dimension(:,:). The destination dense matrix. -! desc_a - type(). The communication descriptor. -! info - integer. Eventually returns an error code -subroutine psb_iinsi(m,irw, val, x, desc_a, info, dupl) +! irw(:) - integer Row indices of rows of val (global numbering) +! val(:,:) - integer The source dense submatrix. +! x(:,:) - integer The destination dense matrix. +! desc_a - type(). The communication descriptor. +! info - integer. return code +! 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 ..... use psb_descriptor_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) 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 int_err(1)=3110 call psb_errpush(info,name) diff --git a/base/tools/psb_loc_to_glob.f90 b/base/tools/psb_loc_to_glob.f90 index 5afc7d34..76e57e87 100644 --- a/base/tools/psb_loc_to_glob.f90 +++ b/base/tools/psb_loc_to_glob.f90 @@ -31,14 +31,17 @@ ! File: psb_loc_to_glob.f90 ! ! 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: -! x - integer, dimension(:). Array containing the indices to be translated. -! y - integer, dimension(:). Array containing the indices to be translated. +! x(:) - integer Array containing the indices to be translated. +! y(:) - integer Array containing the translated indices. ! desc_a - type(). The communication descriptor. -! info - integer. Eventually returns an error code. -! iact - integer(optional). A character defining the behaviour of this subroutine when is found an index not belonging to the calling process +! info - integer. return code. +! 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) @@ -100,9 +103,8 @@ subroutine psb_loc_to_glob2(x,y,desc_a,info,iact) if (info /= 0) then select case(act) - case('E') - call psb_erractionrestore(err_act) - return + case('E','I') + ! do nothing case('W') write(0,'("Error ",i5," in subroutine glob_to_loc")') info case('A') @@ -158,13 +160,17 @@ end subroutine psb_loc_to_glob2 !!$ !!$ ! 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: -! 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(). The communication descriptor. -! info - integer. Eventually returns an error code. -! iact - integer(optional). A character defining the behaviour of this subroutine when is found an index not belonging to the calling process +! info - integer. return code. +! 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) @@ -223,9 +229,9 @@ subroutine psb_loc_to_glob(x,desc_a,info,iact) if (info /= 0) then select case(act) - case('E') - call psb_erractionrestore(err_act) - return + case('E','I') +!!$ call psb_erractionrestore(err_act) +!!$ return case('W') write(0,'("Error ",i5," in subroutine glob_to_loc")') info case('A') diff --git a/base/tools/psb_zallc.f90 b/base/tools/psb_zallc.f90 index d7ef0e91..c7185dde 100644 --- a/base/tools/psb_zallc.f90 +++ b/base/tools/psb_zallc.f90 @@ -33,6 +33,7 @@ ! ! Function: psb_zalloc ! Allocates dense matrix for PSBLAS routines +! The descriptor may be in either the build or assembled state. ! ! Parameters: ! x - the matrix to be allocated. @@ -179,6 +180,7 @@ end subroutine psb_zalloc ! ! Function: psb_zallocv ! Allocates dense matrix for PSBLAS routines +! The descriptor may be in either the build or assembled state. ! ! Parameters: ! x - the matrix to be allocated. diff --git a/base/tools/psb_zasb.f90 b/base/tools/psb_zasb.f90 index 3c5f2420..62271df7 100644 --- a/base/tools/psb_zasb.f90 +++ b/base/tools/psb_zasb.f90 @@ -32,11 +32,15 @@ ! ! Subroutine: psb_zasb ! 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: -! x - real,pointer(dim=2). The matrix to be assembled. +! x(:,:) - complex, allocatable The matrix to be assembled. ! desc_a - type(). The communication descriptor. -! info - integer. Eventually returns an error code +! info - integer. return code subroutine psb_zasb(x, desc_a, info) !....assembly dense matrix x ..... use psb_descriptor_type @@ -158,11 +162,15 @@ end subroutine psb_zasb !!$ ! Subroutine: psb_zasb ! 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: -! x - real,pointer(dim=1). The matrix to be assembled. +! x(:) - complex, allocatable The matrix to be assembled. ! desc_a - type(). The communication descriptor. -! info - integer. Eventually returns an error code +! info - integer. Return code subroutine psb_zasbv(x, desc_a, info) !....assembly dense matrix x ..... use psb_descriptor_type diff --git a/base/tools/psb_zfree.f90 b/base/tools/psb_zfree.f90 index eb637423..0bf777ca 100644 --- a/base/tools/psb_zfree.f90 +++ b/base/tools/psb_zfree.f90 @@ -34,9 +34,9 @@ ! frees a dense matrix structure ! ! Parameters: -! x - real, allocatable, dimension(:,:). The dense matrix to be freed. -! desc_a - type(). The communication descriptor. -! info - integer. Return code +! x(:,:) - complex, allocatable The dense matrix to be freed. +! desc_a - type(). The communication descriptor. +! info - integer. Return code subroutine psb_zfree(x, desc_a, info) !...free dense matrix structure... use psb_const_mod @@ -109,9 +109,9 @@ end subroutine psb_zfree ! frees a dense matrix structure ! ! Parameters: -! x - real, allocatable, dimension(:). The dense matrix to be freed. -! desc_a - type(). The communication descriptor. -! info - integer. Return code +! x(:) - complex, allocatable The dense matrix to be freed. +! desc_a - type(). The communication descriptor. +! info - integer. Return code subroutine psb_zfreev(x, desc_a, info) !...free dense matrix structure... use psb_const_mod diff --git a/base/tools/psb_zins.f90 b/base/tools/psb_zins.f90 index 0d49ca6b..aef7a482 100644 --- a/base/tools/psb_zins.f90 +++ b/base/tools/psb_zins.f90 @@ -29,16 +29,21 @@ !!$ !!$ ! 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: ! m - integer. Number of rows of submatrix belonging to ! val to be inserted. -! irw - integer(:) Row indices of rows of val (global numbering) -! val - complex, dimension(:). The source dense submatrix. -! x - complex, dimension(:). The destination dense matrix. +! irw(:) - integer Row indices of rows of val (global numbering) +! val(:) - complex The source dense submatrix. +! x(:) - complex The destination dense matrix. ! desc_a - 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) !....insert dense submatrix to dense matrix ..... use psb_descriptor_type @@ -75,11 +80,6 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl) call psb_erractionsave(err_act) 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 int_err(1)=3110 call psb_errpush(info,name) @@ -214,16 +214,22 @@ end subroutine psb_zinsvi !!$ !!$ ! 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: ! m - integer. Number of rows of submatrix belonging to ! val to be inserted. -! irw - integer(:) Row indices of rows of val (global numbering) -! val - complex, dimension(:,:). The source dense submatrix. -! x - complex, dimension(:,:). The destination dense matrix. -! desc_a - type(). The communication descriptor. -! info - integer. Eventually returns an error code -subroutine psb_zinsi(m,irw, val, x, desc_a, info, dupl) +! irw(:) - integer Row indices of rows of val (global numbering) +! val(:,:) - complex The source dense submatrix. +! x(:,:) - complex The destination dense matrix. +! desc_a - type(). The communication descriptor. +! info - integer. return code +! 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 ..... use psb_descriptor_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) 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 int_err(1)=3110 call psb_errpush(info,name) diff --git a/base/tools/psb_zspalloc.f90 b/base/tools/psb_zspalloc.f90 index dad3d5db..abe933c0 100644 --- a/base/tools/psb_zspalloc.f90 +++ b/base/tools/psb_zspalloc.f90 @@ -36,8 +36,9 @@ ! Parameters: ! a - type(). The sparse matrix to be allocated. ! desc_a - 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. +! (local, user estimate) ! 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 !locals - integer :: ictxt - integer :: np,me,loc_row,& + integer :: ictxt, dectype + integer :: np,me,loc_row,loc_col,& & length_ia1,length_ia2, err_act,m,n integer :: int_err(5) logical, parameter :: debug=.false. @@ -68,7 +69,9 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) call psb_erractionsave(err_act) 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) ! ....verify blacs grid correctness.. if (np == -1) then @@ -77,14 +80,9 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) goto 9999 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_col = psb_cd_get_local_cols(desc_a) m = psb_cd_get_global_rows(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_ia2=nnz else - length_ia1=max(1,4*loc_row) - length_ia2=max(1,4*loc_row) + length_ia1=max(1,5*loc_row) endif if (debug) write(*,*) 'allocating size:',length_ia1 !....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 info=4010 ch_err='sp_all' diff --git a/base/tools/psb_zspasb.f90 b/base/tools/psb_zspasb.f90 index ac56281b..10f5ab41 100644 --- a/base/tools/psb_zspasb.f90 +++ b/base/tools/psb_zspasb.f90 @@ -31,16 +31,21 @@ ! File: psb_zspasb.f90 ! ! Subroutine: psb_zspasb -! Assembly sparse matrix and set psblas communications -! structures. +! Assemble sparse matrix ! ! Parameters: -! a - type(). The sparse matrix to be allocated. -! desc_a - type(). The communication descriptor to be updated. -! info - integer. Eventually returns an error code. -! afmt - character,dimension(5)(optional). The output format. -! up - character(optional). ??? -! dup - integer(optional). ??? +! a - type(). The sparse matrix to be assembled +! desc_a - type(). The communication descriptor. +! info - integer. return code. +! afmt - character(optional) The desired output storage format. +! upd - character(optional). How will the matrix be updated? +! 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) @@ -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) - 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 info=4010 ch_err='psb_spcnv' diff --git a/base/tools/psb_zspfree.f90 b/base/tools/psb_zspfree.f90 index 1cea4fcc..a25975a3 100644 --- a/base/tools/psb_zspfree.f90 +++ b/base/tools/psb_zspfree.f90 @@ -36,7 +36,7 @@ ! Parameters: ! a - type(). The sparse matrix to be freed. ! desc_a - type(). The communication descriptor. -! info - integer. Eventually returns an error code. +! info - integer. return code. ! subroutine psb_zspfree(a, desc_a,info) !...free sparse matrix structure... diff --git a/base/tools/psb_zsphalo.F90 b/base/tools/psb_zsphalo.F90 index e699ca73..92412265 100644 --- a/base/tools/psb_zsphalo.F90 +++ b/base/tools/psb_zsphalo.F90 @@ -37,21 +37,22 @@ ! ! ! Parameters: -! a - type(psb_zspmat_type) The local part of input matrix A -! desc_a - type(). The communication descriptor. -! blck - type(psb_zspmat_type) The local part of output matrix BLCK -! info - integer. Return code -! rowcnv - logical Should row/col indices be converted -! colcnv - logical to/from global numbering when sent/received? -! default is .TRUE. -! rowscale - logical Should row/col indices on output be remapped -! colscale - logical from MIN:MAX to 1:(MAX-MIN+1) ? -! default is .FALSE. -! (commmon use is ROWSCALE=.TRUE., COLSCALE=.FALSE.) -! data - integer Which index list in desc_a should be used to retrieve -! rows, default psb_comm_halo_ (i.e.: use halo_index) -! other value psb_comm_ext_, no longer accepting -! psb_comm_ovrl_, perhaps should be reinstated in the future. +! a - type(psb_zspmat_type) The local part of input matrix A +! desc_a - type(). The communication descriptor. +! blck - type(psb_zspmat_type) The local part of output matrix BLCK +! info - integer. Return code +! rowcnv - logical Should row/col indices be converted +! colcnv - logical to/from global numbering when sent/received? +! default is .TRUE. +! rowscale - logical Should row/col indices on output be remapped +! colscale - logical from MIN:MAX to 1:(MAX-MIN+1) ? +! default is .FALSE. +! (commmon use is ROWSCALE=.TRUE., COLSCALE=.FALSE.) +! data - integer Which index list in desc_a should be used to retrieve +! rows, default psb_comm_halo_ (i.e.: use halo_index) +! other value psb_comm_ext_, no longer accepting +! psb_comm_ovrl_, perhaps should be reinstated in +! the future. ! ! Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& diff --git a/base/tools/psb_zspins.f90 b/base/tools/psb_zspins.f90 index 74569b95..4eaf3ee5 100644 --- a/base/tools/psb_zspins.f90 +++ b/base/tools/psb_zspins.f90 @@ -31,18 +31,21 @@ ! File: psb_zspins.f90 ! ! 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: -! nz - integer. The number of points to insert. -! ia - integer,dimension(:). The row indices of the points. -! ja - integer,dimension(:). The column indices of the points. -! val - real,dimension(:). The values of the points to be inserted. -! a - type(). The sparse destination matrix. -! desc_a - type(). The communication descriptor. -! info - integer. Error code -! rebuild - logical Allows to reopen a matrix under -! certain circumstances. +! nz - integer. The number of points to insert. +! ia(:) - integer The row indices of the coefficients. +! ja(:) - integer The column indices of the coefficients. +! val(:) - complex The values of the coefficients to be inserted. +! a - type(). The sparse destination matrix. +! desc_a - type(). The communication descriptor. +! info - integer. Error code +! rebuild - logical Allows to reopen a matrix under +! certain circumstances. ! subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) diff --git a/base/tools/psb_zsprn.f90 b/base/tools/psb_zsprn.f90 index f86e59b2..95d8b129 100644 --- a/base/tools/psb_zsprn.f90 +++ b/base/tools/psb_zsprn.f90 @@ -31,12 +31,15 @@ ! File: psb_zsprn.f90 ! ! 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: -! a - type(). The sparse matrix to be reinitiated. -! desc_a - type(). The communication descriptor. -! info - integer. Eventually returns an error code. +! a - type(). The sparse matrix to be reinitiated. +! desc_a - type(). The communication descriptor. +! info - integer. Return code. +! clear - logical, optional Whether the coefficients should be zeroed +! default .true. ! Subroutine psb_zsprn(a, desc_a,info,clear)