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 use psb_string_mod
interface psb_csdp 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 use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
type(psb_dspmat_type), intent(inout) :: b type(psb_dspmat_type), intent(inout) :: b
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: ifc integer, intent(in), optional :: ifc,upd,dupl
character, intent(in), optional :: check,trans,unitd character, intent(in), optional :: check,trans,unitd
end subroutine psb_dcsdp 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 use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_zspmat_type), intent(inout) :: b type(psb_zspmat_type), intent(inout) :: b
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: ifc integer, intent(in), optional :: ifc,upd,dupl
character, intent(in), optional :: check,trans,unitd character, intent(in), optional :: check,trans,unitd
end subroutine psb_zcsdp end subroutine psb_zcsdp
end interface end interface

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

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

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

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

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

@ -43,7 +43,7 @@
! trans - character(optional). ??? ! trans - character(optional). ???
! unitd - 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_const_mod
use psb_error_mod use psb_error_mod
use psb_spmat_type 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(in) :: A
Type(psb_zspmat_type), intent(inout) :: B Type(psb_zspmat_type), intent(inout) :: B
Integer, intent(out) :: info Integer, intent(out) :: info
Integer, intent(in), optional :: ifc Integer, intent(in), optional :: ifc,upd,dupl
character, intent(in), optional :: check,trans,unitd character, intent(in), optional :: check,trans,unitd
!...Locals... !...Locals...
@ -62,7 +62,7 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd)
complex(kind(1.d0)), allocatable :: work(:) complex(kind(1.d0)), allocatable :: work(:)
type(psb_zspmat_type) :: temp_a type(psb_zspmat_type) :: temp_a
Integer :: nzr, ntry, ifc_,ierror, ia1_size,& 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,& integer :: ip1, ip2, nnz, iflag, ichk, nnzt,&
& ipc, i, count, err_act, ierrv(5) & ipc, i, count, err_act, ierrv(5)
character :: check_,trans_,unitd_, up 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 character(len=20) :: name, ch_err
interface psb_cest interface psb_cest
subroutine psb_cest(afmt, m,n,nnz, lia1, lia2, lar, up, info) subroutine psb_cest(afmt, m,n,nnz, lia1, lia2, lar, iup, info)
integer, intent(in) :: m,n,nnz integer, intent(in) :: m,n,nnz,iup
integer, intent(out) :: lia1, lia2, lar, info integer, intent(out) :: lia1, lia2, lar, info
character, intent(inout) :: afmt*5 character, intent(inout) :: afmt*5
character, intent(in) :: up
end subroutine psb_cest end subroutine psb_cest
end interface end interface
@ -150,25 +149,29 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd)
end if end if
if (check_/='R') then 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... ! ...matrix conversion...
b%m=a%m b%m=a%m
b%k=a%k b%k=a%k
call psb_spinfo(psb_nztotreq_,a,size_req,info) 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
! !
iup = psb_sp_getifld(psb_upd_,b,info) upd_ = psb_sp_getifld(psb_upd_,b,info)
if (iup == psb_upd_perm_) then
up = 'Y'
else
up = 'N'
endif
n_row=b%m n_row=b%m
n_col=b%k n_col=b%k
call psb_cest(b%fida, n_row,n_col,size_req,& 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 if (info /= no_err) then
info=4010 info=4010
ch_err='psb_cest' 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_ dupl_ = psb_dupl_def_
endif endif
call psb_sp_setifld(upd_,psb_upd_,a,info)
call psb_sp_setifld(dupl_,psb_dupl_,a,info)
a%m = n_row a%m = n_row
a%k = n_col 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 ! Do the real conversion into the requested storage format
! result is put in A ! 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 (debug) WRITE (*, *) myrow,' ASB: From DCSDP',info,' ',A%FIDA
if (info /= no_err) then 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 endif
call psb_sp_setifld(upd_,psb_upd_,a,info)
call psb_sp_setifld(dupl_,psb_dupl_,a,info)
a%m = n_row a%m = n_row
a%k = n_col 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 ! Do the real conversion into the requested storage format
! result is put in A ! 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 (debug) WRITE (*, *) myrow,' ASB: From DCSDP',info,' ',A%FIDA
if (info /= no_err) then if (info /= no_err) then

Write Preview
Loading…
Cancel
Save