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

Changed csdp to handle dupl and upd as optional parms just like spasb.

Browse Source
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent 4b2f930cf6
commit 70166e50e4
6 changed files with 95 additions and 91 deletions
Show Stats Download Patch File Download Diff File

8
src/modules/psb_serial_mod.f90
Unescape Escape View File

@ -33,20 +33,20 @@ module psb_serial_mod
use psb_string_mod
interface psb_csdp
subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd)
subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
type(psb_dspmat_type), intent(inout) :: b
integer, intent(out) :: info
integer, intent(in), optional :: ifc
integer, intent(in), optional :: ifc,upd,dupl
character, intent(in), optional :: check,trans,unitd
end subroutine psb_dcsdp
subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd)
subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
type(psb_zspmat_type), intent(inout) :: b
integer, intent(out) :: info
integer, intent(in), optional :: ifc
integer, intent(in), optional :: ifc,upd,dupl
character, intent(in), optional :: check,trans,unitd
end subroutine psb_zcsdp
end interface

101
src/serial/psb_cest.f90
Unescape Escape View File

@ -28,15 +28,15 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine psb_cest(afmt, m,n,nnz, lia1, lia2, lar, up, info)
subroutine psb_cest(afmt, m,n,nnz, lia1, lia2, lar, iup, info)
use psb_error_mod
use psb_const_mod
implicit none
! .. scalar arguments ..
integer :: m,n,nnz, lia1, lia2, lar, info
character :: up
integer, intent(in) :: m,n,nnz,iup
integer, intent(out) :: lia1, lia2, lar, info
! .. array arguments..
character(len=5) :: afmt
integer :: int_val(5), err_act
@ -46,55 +46,56 @@ subroutine psb_cest(afmt, m,n,nnz, lia1, lia2, lar, up, info)
call psb_erractionsave(err_act)
if (afmt.eq.'???') then
afmt = psb_fidef_
afmt = psb_fidef_
endif
if ((up.eq.'y').or.(up.eq.'Y')) then
if (afmt.eq.'JAD') then
lia1 = 2*(nnz + nnz/5) +1000
lia2 = 2*(nnz + nnz/5) +1000 +m
lar = nnz + nnz/5
else if (afmt.eq.'COO') then
lia1 = nnz
lia2 = 2*nnz + 1000
lar = nnz
else if(afmt.eq.'CSR') then
lia1 = nnz
lia2 = 2*nnz + 1000 + m + 1
lar = nnz
else
info = 136
call psb_errpush(info,name,a_err=afmt)
goto 9999
endif
else if ((up.eq.'n').or.(up.eq.'N')) then
if (afmt.eq.'JAD') then
lia1 = nnz + nnz/5
lia2 = nnz + nnz/5
lar = nnz + nnz/5
else if (afmt.eq.'COO') then
lia1 = nnz
lia2 = nnz
lar = nnz
else if(afmt.eq.'CSR') then
lia1 = nnz
lia2 = nnz
lar = nnz
else
info = 136
call psb_errpush(info,name,a_err=afmt)
goto 9999
endif
else
info = 3012
call psb_errpush(info,name,int_val)
goto 9999
endif
select case(iup)
case (psb_upd_perm_)
if (afmt.eq.'JAD') then
lia1 = 2*(nnz + nnz/5) +1000
lia2 = 2*(nnz + nnz/5) +1000 +m
lar = nnz + nnz/5
else if (afmt.eq.'COO') then
lia1 = nnz
lia2 = 2*nnz + 1000
lar = nnz
else if(afmt.eq.'CSR') then
lia1 = nnz
lia2 = 2*nnz + 1000 + m + 1
lar = nnz
else
info = 136
call psb_errpush(info,name,a_err=afmt)
goto 9999
endif
case (psb_upd_dflt_, psb_upd_srch_)
if (afmt.eq.'JAD') then
lia1 = nnz + nnz/5
lia2 = nnz + nnz/5
lar = nnz + nnz/5
else if (afmt.eq.'COO') then
lia1 = nnz
lia2 = nnz
lar = nnz
else if(afmt.eq.'CSR') then
lia1 = nnz
lia2 = nnz
lar = nnz
else
info = 136
call psb_errpush(info,name,a_err=afmt)
goto 9999
endif
case default
info = 3012
call psb_errpush(info,name,int_val)
goto 9999
end select
call psb_erractionrestore(err_act)
return

35
src/serial/psb_dcsdp.f90
Unescape Escape View File

@ -43,7 +43,7 @@
! trans - character(optional). ???
! unitd - character(optional). ???
!
subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd)
subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
use psb_const_mod
use psb_error_mod
use psb_spmat_type
@ -54,7 +54,7 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd)
Type(psb_dspmat_type), intent(in) :: A
Type(psb_dspmat_type), intent(inout) :: B
Integer, intent(out) :: info
Integer, intent(in), optional :: ifc
Integer, intent(in), optional :: ifc,upd,dupl
character, intent(in), optional :: check,trans,unitd
!...Locals...
@ -62,7 +62,7 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd)
real(kind(1.d0)), allocatable :: work(:)
type(psb_dspmat_type) :: temp_a
Integer :: nzr, ntry, ifc_,ierror, ia1_size,&
& ia2_size, aspk_size,size_req,n_row,n_col,iup
& ia2_size, aspk_size,size_req,n_row,n_col,upd_,dupl_
integer :: ip1, ip2, nnz, iflag, ichk, nnzt,&
& ipc, i, count, err_act, ierrv(5)
character :: check_,trans_,unitd_, up
@ -71,11 +71,10 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd)
character(len=20) :: name, ch_err
interface psb_cest
subroutine psb_cest(afmt, m,n,nnz, lia1, lia2, lar, up, info)
integer, intent(in) :: m,n,nnz
subroutine psb_cest(afmt, m,n,nnz, lia1, lia2, lar, iup, info)
integer, intent(in) :: m,n,nnz,iup
integer, intent(out) :: lia1, lia2, lar, info
character, intent(inout) :: afmt*5
character, intent(in) :: up
end subroutine psb_cest
end interface
@ -115,12 +114,14 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd)
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)
endif
if (info /= 0) then
info=2040
call psb_errpush(info,name)
@ -149,26 +150,32 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd)
end if
if (check_/='R') then
if (present(upd)) then
call psb_sp_setifld(upd,psb_upd_,b,info)
end if
if (present(dupl)) then
call psb_sp_setifld(dupl,psb_dupl_,b,info)
end if
! ...matrix conversion...
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
!
iup = psb_sp_getifld(psb_upd_,b,info)
if (iup == psb_upd_perm_) then
up = 'Y'
else
up = 'N'
endif
upd_ = psb_sp_getifld(psb_upd_,b,info)
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, up,info)
& ia1_size, ia2_size, aspk_size, upd_,info)
!!$ write(0,*) 'ESTIMATE : ',ia1_size,ia2_size,aspk_Size,iup
!!$ write(0,*) 'ESTIMATE : ',ia1_size,ia2_size,aspk_Size,upd_
if (info /= no_err) then
info=4010
ch_err='psb_cest'

31
src/serial/psb_zcsdp.f90
Unescape Escape View File

@ -43,7 +43,7 @@
! trans - character(optional). ???
! unitd - character(optional). ???
!
subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd)
subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
use psb_const_mod
use psb_error_mod
use psb_spmat_type
@ -54,7 +54,7 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd)
Type(psb_zspmat_type), intent(in) :: A
Type(psb_zspmat_type), intent(inout) :: B
Integer, intent(out) :: info
Integer, intent(in), optional :: ifc
Integer, intent(in), optional :: ifc,upd,dupl
character, intent(in), optional :: check,trans,unitd
!...Locals...
@ -62,7 +62,7 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd)
complex(kind(1.d0)), allocatable :: work(:)
type(psb_zspmat_type) :: temp_a
Integer :: nzr, ntry, ifc_,ierror, ia1_size,&
& ia2_size, aspk_size,size_req,n_row,n_col,iup
& ia2_size, aspk_size,size_req,n_row,n_col,upd_,dupl_
integer :: ip1, ip2, nnz, iflag, ichk, nnzt,&
& ipc, i, count, err_act, ierrv(5)
character :: check_,trans_,unitd_, up
@ -71,11 +71,10 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd)
character(len=20) :: name, ch_err
interface psb_cest
subroutine psb_cest(afmt, m,n,nnz, lia1, lia2, lar, up, info)
integer, intent(in) :: m,n,nnz
subroutine psb_cest(afmt, m,n,nnz, lia1, lia2, lar, iup, info)
integer, intent(in) :: m,n,nnz,iup
integer, intent(out) :: lia1, lia2, lar, info
character, intent(inout) :: afmt*5
character, intent(in) :: up
end subroutine psb_cest
end interface
@ -150,25 +149,29 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd)
end if
if (check_/='R') then
if (present(upd)) then
call psb_sp_setifld(upd,psb_upd_,b,info)
end if
if (present(dupl)) then
call psb_sp_setifld(dupl,psb_dupl_,b,info)
end if
! ...matrix conversion...
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
!
iup = psb_sp_getifld(psb_upd_,b,info)
if (iup == psb_upd_perm_) then
up = 'Y'
else
up = 'N'
endif
upd_ = psb_sp_getifld(psb_upd_,b,info)
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, up,info)
& ia1_size, ia2_size, aspk_size, upd_,info)
!!$ write(0,*) 'ESTIMATE : ',ia1_size,ia2_size,aspk_Size,iup
!!$ write(0,*) 'ESTIMATE : ',ia1_size,ia2_size,aspk_Size,upd_
if (info /= no_err) then
info=4010
ch_err='psb_cest'

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

@ -136,10 +136,6 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl)
dupl_ = psb_dupl_def_
endif
call psb_sp_setifld(upd_,psb_upd_,a,info)
call psb_sp_setifld(dupl_,psb_dupl_,a,info)
a%m = n_row
a%k = n_col
@ -167,7 +163,7 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl)
! Do the real conversion into the requested storage format
! result is put in A
call psb_csdp(atemp,a,info,ifc=2)
call psb_csdp(atemp,a,info,ifc=2,upd=upd_,dupl=dupl_)
IF (debug) WRITE (*, *) myrow,' ASB: From DCSDP',info,' ',A%FIDA
if (info /= no_err) then

5
src/tools/psb_zspasb.f90
Unescape Escape View File

@ -137,9 +137,6 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl)
endif
call psb_sp_setifld(upd_,psb_upd_,a,info)
call psb_sp_setifld(dupl_,psb_dupl_,a,info)
a%m = n_row
a%k = n_col
@ -167,7 +164,7 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl)
! Do the real conversion into the requested storage format
! result is put in A
call psb_csdp(atemp,a,info,ifc=2)
call psb_csdp(atemp,a,info,ifc=2,upd=upd_,dupl=dupl_)
IF (debug) WRITE (*, *) myrow,' ASB: From DCSDP',info,' ',A%FIDA
if (info /= no_err) then

Write Preview
Loading…
Cancel
Save