mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-24 14:51:49 +00:00
Modified interface to GEALL, GEINS et al.
Changed ITRACE behaviour in solver routines. Updated documentation.
This commit is contained in:
Salvatore Filippone
@@ -118,8 +118,7 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
|
||||
if (check_=='R') then
|
||||
allocate(work(max(size(a%aspk),size(b%aspk))+1000),stat=info)
|
||||
else
|
||||
allocate(work(max(size(a%ia1),size(b%ia1),&
|
||||
& size(a%ia2),size(b%ia2))+max(a%m,b%m)+1000),stat=info)
|
||||
allocate(work(max(size(a%ia1),size(a%ia2))+max(a%m,b%m)+1000),stat=info)
|
||||
endif
|
||||
|
||||
if (info /= 0) then
|
||||
@@ -196,13 +195,20 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
endif
|
||||
if ((size(b%aspk) < aspk_size) .or.&
|
||||
if (.not.associated(b%aspk).or.&
|
||||
&.not.associated(b%ia1).or.&
|
||||
&.not.associated(b%ia2).or.&
|
||||
&.not.associated(b%pl).or.&
|
||||
&.not.associated(b%pr)) then
|
||||
call psb_sp_reall(b,ia1_size,ia2_size,aspk_size,info)
|
||||
else if ((size(b%aspk) < aspk_size) .or.&
|
||||
&(size(b%ia1) < ia1_size) .or.&
|
||||
&(size(b%ia2) < ia2_size) .or.&
|
||||
&(size(b%pl) < b%m) .or.&
|
||||
&(size(b%pr) < b%k )) then
|
||||
call psb_sp_reall(b,ia1_size,ia2_size,aspk_size,info)
|
||||
endif
|
||||
|
||||
if (info /= no_err) then
|
||||
info=4010
|
||||
ch_err='psb_sp_reall'
|
||||
|
||||
@@ -67,7 +67,7 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
|
||||
& ipc, i, count, err_act, ierrv(5), i1, i2, ia
|
||||
character :: check_,trans_,unitd_, up
|
||||
Integer, Parameter :: maxtry=8
|
||||
logical, parameter :: debug=.false.
|
||||
logical, parameter :: debug=.true.
|
||||
character(len=20) :: name, ch_err
|
||||
|
||||
interface psb_cest
|
||||
@@ -114,11 +114,11 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
|
||||
unitd_ = 'U'
|
||||
endif
|
||||
|
||||
|
||||
if (check_=='R') then
|
||||
allocate(work(max(size(a%aspk),size(b%aspk))+1000),stat=info)
|
||||
else
|
||||
allocate(work(max(size(a%ia1),size(b%ia1),&
|
||||
& size(a%ia2),size(b%ia2))+max(a%m,b%m)+1000),stat=info)
|
||||
allocate(work(max(size(a%ia1),size(a%ia2))+max(a%m,b%m)+1000),stat=info)
|
||||
endif
|
||||
|
||||
if (info /= 0) then
|
||||
@@ -127,7 +127,7 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
|
||||
goto 9999
|
||||
end if
|
||||
if (ifc_<1) then
|
||||
write(0,*) 'dcsdp90 Error: invalid ifc ',ifc_
|
||||
write(0,*) 'csdp90 Error: invalid ifc ',ifc_
|
||||
info = -4
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
@@ -181,13 +181,15 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
|
||||
b%m=a%m
|
||||
b%k=a%k
|
||||
call psb_spinfo(psb_nztotreq_,a,size_req,info)
|
||||
if (debug) write(0,*) 'DCSDP : size_req 1:',size_req
|
||||
if (debug) write(0,*) 'DCSDP : size_req 1:',size_req,a%m,a%k
|
||||
!
|
||||
|
||||
n_row=b%m
|
||||
n_col=b%k
|
||||
call psb_cest(b%fida, n_row,n_col,size_req,&
|
||||
& ia1_size, ia2_size, aspk_size, upd_,info)
|
||||
!!$ write(0,*) size(b%aspk),size(b%ia1),size(b%ia2),size(b%pl),size(b%pr),&
|
||||
!!$ & ia1_size, ia2_size, aspk_size,b%fida,b%m,b%k
|
||||
|
||||
if (info /= no_err) then
|
||||
info=4010
|
||||
@@ -195,13 +197,20 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
endif
|
||||
if ((size(b%aspk) < aspk_size) .or.&
|
||||
if (.not.associated(b%aspk).or.&
|
||||
&.not.associated(b%ia1).or.&
|
||||
&.not.associated(b%ia2).or.&
|
||||
&.not.associated(b%pl).or.&
|
||||
&.not.associated(b%pr)) then
|
||||
call psb_sp_reall(b,ia1_size,ia2_size,aspk_size,info)
|
||||
else if ((size(b%aspk) < aspk_size) .or.&
|
||||
&(size(b%ia1) < ia1_size) .or.&
|
||||
&(size(b%ia2) < ia2_size) .or.&
|
||||
&(size(b%pl) < b%m) .or.&
|
||||
&(size(b%pr) < b%k )) then
|
||||
call psb_sp_reall(b,ia1_size,ia2_size,aspk_size,info)
|
||||
endif
|
||||
|
||||
if (info /= no_err) then
|
||||
info=4010
|
||||
ch_err='psb_sp_reall'
|
||||
|
||||
@@ -0,0 +1,92 @@
|
||||
!!$
|
||||
!!$ 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_ztransc.f90
|
||||
! Subroutine:
|
||||
! Parameters:
|
||||
|
||||
subroutine psb_ztransc(a,b,c,fmt)
|
||||
use psb_spmat_type
|
||||
use psb_tools_mod
|
||||
use psb_string_mod
|
||||
use psb_serial_mod, only : psb_ipcoo2csr, psb_ipcsr2coo, psb_fixcoo
|
||||
implicit none
|
||||
|
||||
type(psb_zspmat_type) :: a,b
|
||||
integer, optional :: c
|
||||
character(len=*), optional :: fmt
|
||||
|
||||
character(len=5) :: fmt_
|
||||
integer ::c_, info, nz, i
|
||||
integer, pointer :: itmp(:)
|
||||
if (present(c)) then
|
||||
c_=c
|
||||
else
|
||||
c_=1
|
||||
endif
|
||||
if (present(fmt)) then
|
||||
fmt_ = toupper(fmt)
|
||||
else
|
||||
fmt_='CSR'
|
||||
endif
|
||||
if (associated(b%aspk)) call psb_sp_free(b,info)
|
||||
call psb_sp_clone(a,b,info)
|
||||
|
||||
if (b%fida=='CSR') then
|
||||
call psb_ipcsr2coo(b,info)
|
||||
else if (b%fida=='COO') then
|
||||
! do nothing
|
||||
else
|
||||
write(0,*) 'Unimplemented case in TRANSC '
|
||||
endif
|
||||
itmp => b%ia1
|
||||
b%ia1 => b%ia2
|
||||
b%ia2 => itmp
|
||||
|
||||
b%m = a%k
|
||||
b%k = a%m
|
||||
|
||||
do i=1, b%infoa(psb_nnz_)
|
||||
b%aspk(i) = conjg(b%aspk(i))
|
||||
end do
|
||||
|
||||
!!$ write(0,*) 'Calling IPCOO2CSR from transc90 ',b%m,b%k
|
||||
if (fmt_=='CSR') then
|
||||
call psb_ipcoo2csr(b,info)
|
||||
b%fida='CSR'
|
||||
else if (fmt_=='COO') then
|
||||
call psb_fixcoo(b,info)
|
||||
b%fida='COO'
|
||||
else
|
||||
write(0,*) 'Unknown FMT in TRANSC : "',fmt_,'"'
|
||||
endif
|
||||
|
||||
return
|
||||
end subroutine psb_ztransc
|
||||
@@ -45,7 +45,7 @@ subroutine psb_ztransp(a,b,c,fmt)
|
||||
|
||||
character(len=5) :: fmt_
|
||||
integer ::c_, info, nz
|
||||
integer, pointer :: itmp(:)=>null()
|
||||
integer, pointer :: itmp(:)
|
||||
if (present(c)) then
|
||||
c_=c
|
||||
else
|
||||
|
||||
Reference in New Issue
Block a user